Tính Tổng các nhóm dữ liệu

[myanhnet200]

Mình có file đính kèm cần code VBA để tính tổng sau mỗi nhóm hàng tại vị trí bôi vàng (dòng trống sau mỗi nhóm), cần duyệt từ cell K21 đến lastrow, tính tổng

 

[snow25]

Mình có file đính kèm cần code VBA để tính tổng sau mỗi nhóm hàng tại vị trí bôi vàng (dòng trống sau mỗi nhóm), cần duyệt từ cell K21 đến lastrow, tính tổng

Bạn chạy thử code này nhé.

Sub tinhtong()
    Dim arr, Tong As Double, i As Long, lr As Long
    lr = Range("A" & Rows.Count).End(xlUp).Row
    If lr < 22 Then Exit Sub
    arr = Range("J22:K" & lr).Value
    For i = 1 To UBound(arr, 1)
        If arr(i, 1) <> Empty Then
           Tong = Tong + arr(i, 2)
        ElseIf Tong <> 0 Then
           arr(i, 2) = Tong
           Tong = 0
        End If
    Next i
    Range("J22:K" & lr).Value = arr
End Sub

 

[CHAOQUAY]

Bạn chạy thử code này nhé.

Sub tinhtong()
    Dim arr, Tong As Double, i As Long, lr As Long
    lr = Range("A" & Rows.Count).End(xlUp).Row
    If lr < 22 Then Exit Sub
    arr = Range("J22:K" & lr).Value
    For i = 1 To UBound(arr, 1)
        If arr(i, 1) <> Empty Then
           Tong = Tong + arr(i, 2)
        ElseIf Tong <> 0 Then
           arr(i, 2) = Tong
           Tong = 0
        End If
    Next i
    Range("J22:K" & lr).Value = arr
End Sub

Hình nhu bị thiếu tong cuối cùng thì phải

 

[LamNA]

Hình nhu bị thiếu tong cuối cùng thì phải

Theo em hiểu tính dòng cuối cột A vì thế công thêm 1 ở dòng này

lr = Range("A" & Rows.Count).End(xlUp).Row + 1

Sub tinhtong()
    Dim arr, Tong As Double, i As Long, lr As Long
    lr = Range("A" & Rows.Count).End(xlUp).Row + 1
    If lr < 22 Then Exit Sub
    arr = Range("J22:K" & lr).Value
    For i = 1 To UBound(arr, 1)
        If arr(i, 1) <> Empty Then
           Tong = Tong + arr(i, 2)
        ElseIf Tong <> 0 Then
           arr(i, 2) = Tong
           Tong = 0
        End If
    Next i
    Range("J22:K" & lr).Value = arr
End Sub

 

[snow25]

Theo em hiểu tính dòng cuối cột A vì thế công thêm 1 ở dòng này

lr = Range("A" & Rows.Count).End(xlUp).Row + 1

Sub tinhtong()
    Dim arr, Tong As Double, i As Long, lr As Long
    lr = Range("A" & Rows.Count).End(xlUp).Row + 1
    If lr < 22 Then Exit Sub
    arr = Range("J22:K" & lr).Value
    For i = 1 To UBound(arr, 1)
        If arr(i, 1) <> Empty Then
           Tong = Tong + arr(i, 2)
        ElseIf Tong <> 0 Then
           arr(i, 2) = Tong
           Tong = 0
        End If
    Next i
    Range("J22:K" & lr).Value = arr
End Sub

Lúc làm xong mới để ý.

 

[be_09]

Mình có file đính kèm cần code VBA để tính tổng sau mỗi nhóm hàng tại vị trí bôi vàng (dòng trống sau mỗi nhóm), cần duyệt từ cell K21 đến lastrow, tính tổng

Thử thêm một code tà đạo.
Nếu có dữ liệu mới thì Copy và Paste vào sheet1, xong vào sheet2 nhấn nút để xem kết quả.

 

[myanhnet200]

Thử thêm một code tà đạo.
Nếu có dữ liệu mới thì Copy và Paste vào sheet1, xong vào sheet2 nhấn nút để xem kết quả.

Cám ơn 2 Pro, mình chạy ổn, nhưng cần định dạng tự động tổng mỗi nhóm theo accouting 2 số sau thập phân và in đậm, thêm chữ "TC" cell bên trái mỗi tổng, kính mong 2 Pro giúp hoàn thiện

 

[newstar611]

Xin hỏi có cách nào tính tổng khi dòng tổng ở dòng đầu không ( thay vì dòng cuối như bài trên) ?