Nhờ tính tổng theo các thành phần bằng VBA

[nguyenmanhnam]

Xin hộ em về tính tổng theo các thành phần (tính tổng cột C theo số thứ tự công việc ở cột A).

Do em chưa biết nhiều, ví dụ có vẻ hơi "Ngố", mong các thày giúp.

 

[Dauthivan]

Sao kg dùng ct subtotal mà phải viết code.
Bạn xem coe nhé, xét theo cột A và tính tổng cột C.

Sub TinhTong()
Dim endR&, i&, sotien As Double
Dim Arr()
With Sheet1
  'Xac dong cell cuoi co du lieu o cot C tu dong 65000 - dau'
  endR = .Cells(65000, 3).End(xlUp).Row
  'Gan vao array cot can tinh'
  Arr = .Range("A2:C" & endR).Value
End With
'Dung vong lap' UBound(Arr)= so dong cua arr
For i = UBound(Arr) To 1 Step -1 'duyt tu duoi len
  If Len(Arr(i, 1)) > 0 Then 'ie o nay chua co gi
    Arr(i, 3) = sotien 'gan vao C
    sotien = 0
  Else
    sotien = sotien + Arr(i, 3)
  End If
Next i
'gán vào
With Sheet1
  .[A2].Resize(UBound(Arr), 3) = Arr
End With
Erase Arr
End Sub

Nếu file ex 2007 thì save thành xlsm

Em suy nghĩ mãi mà chưa ra đươc sự cần thiết của đoạn:
With Sheet1
.[A2].Resize(UBound(Arr), 3) = Arr
End With
Erase Arr
để làm gì? Bởi em cứ nghĩ đoạn thế này là đủ thôi chứ:

Sub TinhTong()
Dim endR&, i&, sotien As Double
Dim Arr()
With Sheet1
  'Xac dong cell cuoi co du lieu o cot C tu dong 65000 - dau'
  endR = .Cells(65000, 3).End(xlUp).Row
  'Gan vao array cot can tinh'
  Arr = .Range("A2:C" & endR).Value
End With
'Dung vong lap' UBound(Arr)= so dong cua arr
For i = UBound(Arr) To 1 Step -1 'duyt tu duoi len
  If Len(Arr(i, 1)) > 0 Then 'ie o nay chua co gi
    Arr(i, 3) = sotien 'gan vao C
    sotien = 0
  Else
    sotien = sotien + Arr(i, 3)
  End If
Next i
End Sub

Rất mong mọi người chỉ giúp em.

 

[nmhung49]

Em suy nghĩ mãi mà chưa ra đươc sự cần thiết của đoạn:
With Sheet1
.[A2].Resize(UBound(Arr), 3) = Arr
End With
Erase Arr
để làm gì?

Không có đoạn này thì bạn không thấy kết quả trên sheet đâu bạn đoạn này rất rất quan trọng, dữ liệu sao khi tính toán được gán vào trong mảng thì phải xuất ra chứ không lẽ để trong mảng nói chung bạn dùng mảng để tính toán tạm rồi lấy cái tạm đó ra

 

[Dauthivan]

Với điều kiện dữ liệu này bạn làm như thế này xem sao

Sub testtong()
Dim arr, arrkq, lRow As Long, kqrow As Long
Range("c2,c6").ClearContents
arr = Range("c2:c10").Value
For lRow = 1 To UBound(arr, 1)

    If arr(lRow, 1) = "" Then
        kqrow = lRow
        arrkq = 0
    End If
    
    arrkq = arrkq + arr(lRow, 1)
    Cells(kqrow + 1, 3).Value = arrkq
    
Next

End Sub

Em phân tích mãi mà chưa hiểu, mong các bác giải thích nghĩa đoạn Code hộ em.