Sửa dùm code đánh số thứ tự và kẻ bảng

[NH_DK]

Em đang gặp khó khăn trong việc đánh số thứ tự và kẻ bảng. Em đưa file lên nhờ AC xem và sửa dùm em nhé!
Cám ơn AC nhiều!

 

[Nguyễn Duy Tuân]

Em đang gặp khó khăn trong việc đánh số thứ tự và kẻ bảng. Em đưa file lên nhờ AC xem và sửa dùm em nhé!
Cám ơn AC nhiều!

Code Tao_So mình sửa như thế này:

Sub Tao_So()
    Dim iR As Long, iR1 As Long, eR As Long, [COLOR="red"]I&, DongDau&[/COLOR]
    Application.ScreenUpdating = False
    iR = s3.Range("A30000").End(3).Row
    S8.Range("A9:L30000").Clear
    s3.Range("A2:B" & iR).Copy S8.Range("B9")
    iR1 = s1.Range("A30000").End(3).Row
    With S8
        .Range("F9").FormulaR1C1 = "=SUMPRODUCT((LEFT(CSDL!R3C1:R" & iR1 & "C1,2)=NXT!R6C)*(CSDL!R3C10:R" & iR1 & "C10=NXT!RC2)*CSDL!R3C13:R" & iR1 & "C13)"
        .Range("G9").FormulaR1C1 = "=SUMPRODUCT((LEFT(CSDL!R3C1:R" & iR1 & "C1,2)=NXT!R6C[-1])*(CSDL!R3C10:R" & iR1 & "C10=NXT!RC2)*CSDL!R3C15:R" & iR1 & "C15)"
        .Range("H9").FormulaR1C1 = "=SUMPRODUCT((LEFT(CSDL!R3C1:R" & iR1 & "C1,2)=NXT!R6C)*(CSDL!R3C10:R" & iR1 & "C10=NXT!RC2)*CSDL!R3C13:R" & iR1 & "C13)"
        .Range("I9").FormulaR1C1 = "=SUMPRODUCT((LEFT(CSDL!R3C1:R" & iR1 & "C1,2)=NXT!R6C[-1])*(CSDL!R3C10:R" & iR1 & "C10=NXT!RC2)*CSDL!R3C15:R" & iR1 & "C15)"
        .Range("J9").FormulaR1C1 = "=(RC[-6]+RC[-4]-RC[-2])"
        .Range("K9").FormulaR1C1 = "=RC[-1]*RC[1]"
        .Range("L9").FormulaR1C1 = "=(RC[-7]+RC[-5])/(RC[-8]+RC[-6])"
        eR = .Range("B30000").End(3).Row
        .Range("F9:L9").Copy .Range("F9:L" & eR)
        .Range("F9:L" & eR).Value = .Range("F9:L" & eR).Value
        .Range("F9:L" & eR).NumberFormat = "_(* #,##0_);_(* (#,##0);"""""
    End With
    'Số thứ tự
[COLOR="red"]        DongDau = 9
        For I = DongDau To eR
            S8.Cells(I, 1).Value = I - DongDau + 1
        Next I[/COLOR]
        
        S6.[A20:L24].Copy S8.[A65536].End(3).Offset(1)
     'Kẻ viền
        With [COLOR="red"]S8.Range("A" & DongDau - 1 & ":L" & eR).Offset(1)[/COLOR]
            .BorderAround LineStyle:=1
            .Borders(11).LineStyle = 1: .Borders(11).ColorIndex = 1
            .Borders(12).LineStyle = 1: .Borders(12).ColorIndex = 1: .Borders(xlInsideHorizontal).Weight = xlThin
        End With
        S8.Cells(eR + 1, "D").Resize(, 8).FormulaR1C1 = "=SUM(R9C:R[-1]C)"
    Application.ScreenUpdating = True
End Sub

 

[boyxin]

Em đang gặp khó khăn trong việc đánh số thứ tự và kẻ bảng. Em đưa file lên nhờ AC xem và sửa dùm em nhé!
Cám ơn AC nhiều!

Dùng thử cái này xem sao nhé

Sub Tao_So()
    Dim iR As Long, iR1 As Long
    Application.ScreenUpdating = False
    iR = s3.Range("A30000").End(3).Row
    S8.Range("A9:L30000").Clear
    s3.Range("A2:B" & iR).Copy S8.Range("B9")
    iR1 = s1.Range("A30000").End(3).Row
    With S8.[f9].Resize(iR - 1)
        .FormulaR1C1 = "=SUMPRODUCT((LEFT(CSDL!R3C1:R" & iR1 & "C1,2)=NXT!R6C)*(CSDL!R3C10:R" & iR1 & "C10=NXT!RC2)*CSDL!R3C13:R" & iR1 & "C13)"
        .Offset(, 1).FormulaR1C1 = "=SUMPRODUCT((LEFT(CSDL!R3C1:R" & iR1 & "C1,2)=NXT!R6C[-1])*(CSDL!R3C10:R" & iR1 & "C10=NXT!RC2)*CSDL!R3C15:R" & iR1 & "C15)"
        .Offset(, 2).FormulaR1C1 = "=SUMPRODUCT((LEFT(CSDL!R3C1:R" & iR1 & "C1,2)=NXT!R6C)*(CSDL!R3C10:R" & iR1 & "C10=NXT!RC2)*CSDL!R3C13:R" & iR1 & "C13)"
        .Offset(, 3).FormulaR1C1 = "=SUMPRODUCT((LEFT(CSDL!R3C1:R" & iR1 & "C1,2)=NXT!R6C[-1])*(CSDL!R3C10:R" & iR1 & "C10=NXT!RC2)*CSDL!R3C15:R" & iR1 & "C15)"
        .Offset(, 4).FormulaR1C1 = "=(RC[-6]+RC[-4]-RC[-2])"
        .Offset(, 5).FormulaR1C1 = "=RC[-1]*RC[1]"
        .Offset(, 6).FormulaR1C1 = "=(RC[-7]+RC[-5])/(RC[-8]+RC[-6])"
        
        S6.[A20:L24].Copy S8.[A9].Offset(iR - 1)
        S8.[f9].Offset(iR - 1, -2).Resize(, 8).FormulaR1C1 = "=SUM(R9C:R[-1]C)"
        .Offset(, -2).Resize(iR, 9) = .Offset(, -2).Resize(iR, 9).Value
    End With
        S8.[f9].Offset(iR - 1).Resize(7).NumberFormat = "_(* #,##0_);_(* (#,##0);"""""
        If iR > 2 Then
            S8.[A9].Resize(iR - 1) = Evaluate("row(R:R)")
        End If
        With S8.[A9].Resize(iR - 1, 12)
            .BorderAround LineStyle:=1
            .Borders(11).LineStyle = 1
            .Borders(12).LineStyle = 1
        End With
    Application.ScreenUpdating = True
End Sub