Giúp đỡ tính tổng bằng VBA !!!

Chia sẻ bởi:hands

★★★★★

‹ Đếm số cặp số trùng nhau Tính tổng nhiều điều kiện, không tính... ›

Quảng cáo

Em muốn tỉnh tổng ở các ô bôi vàng bằng Macro nhưn đã loay hoay mấy ngày nay vẫn không được. Nhờ anh/ chị hỗ trợ giúp ạ.
826
Đây là file danh sách và macro mình làm thử nhưng chạy không ra được đúng sum tổng ở các dòng dưới:
Sub Tinhtong()
 Dim m As Long
  Dim rA As Range
    For Each rA In Range("C7", Range("F" & Rows.Count).End(xlUp)).SpecialCells(xlConstants, xlNumbers).Areas
   rA.Cells(0).Formula = "=SUM(" & rA.Address & ")"
  Next rA
End Sub
Em cám ơn nhiều

Bạn xem thử. . .

Cám ơn bạn rất nhiều 😀 😀 😀 😀

Bài này là kinh điển kỹ thuật của nhà băng cuối ngày sort phát sinh, gộp, và tính tổng. Chỉ là ở đây, người ta làm ngược tổng từ dưới lên (ít có, nhưng không hẳn là không ai làm)
Kỹ thuật này chủ yếu làm trên hai tổng (sub/grand totals) và một lính canh (sentinel)
– Tổng chung (grand totals) tích lũy từ đầu chiis chuoios
– Tổng nhỏ (sub totals) được set lại 0 ở đầu mỗi nhóm và tích lũy cho đến cuối nhóm.
– Lính canh dùng để báo hiệu khi đến nhóm mới.

' đạon code dưới đây tôi dùng 1 to 5 là vì lười biếng. Khi code thật, tôi dùng biến hoặc hằng.
Dim totSub(1 To 5) As Double, totGrandt(1 To 5) As Double, totCols Aa Variant
totCols= VBA.Array("", "C", "D", "E", "F", "G")
curLine = … ' code tìm dòng cuối
Do While Cells(curLine, 1) <> chuỗi ở dòng tổng
If (Cells(curLine, 1) = chuỗi tổng nhóm Then
For i = 1 To 5
Cells(curLine, totCols(i)) = totSub(i)
totGrand(i) = totGrand(i) + totSub(i)
Next i
Erase totSub
Else
For i = 1 To 5
totSub(i) = totSub(i) + Cells(curLine, totCols(i))
Next i
End If
Loop
For i = 1 To 5
Cells(curLine, totCols(i)) = totGrand(i)
Next i

Vì ở bài này dòng cuối mỗi nhóm đã có sẵn cho nên cách làm khá dễ. Bình thường thì phải sử dụng lính canh, so sánh nhóm hiện tại với dòng đang đọc. Nếu gióng thì là còn trong nhóm, nếu khác thì đã qua nhóm mới:
– ghi tổng lại
– xóa các tổng về 0
– chuyển lính canh (nhóm hiện tại = nhốm mới)
Kỹ thuật kinh điển. Tôi chỉ nếu ra đây cho các bạn biết ngày xưa lập trình tổng kết phát sinh là như thế nào.

Dùng mảng code chạy nhay hơn

Sub ABC()
Dim sh As Worksheet, rng As Range, TT(), t(), sR&, i&, j&
  Set sh = ThisWorkbook.Sheets("VP_2")
  Set rng = sh.Range("A6:F" & sh.Range("A1000000").End(xlUp).Row)
  sR = rng.Rows.Count
  ReDim TT(1 To 1, 1 To 4)
  ReDim t(1 To 1, 1 To 4)
  For i = sR To 1 Step -1
    If IsNumeric(rng(i, 1)) Then
      For j = 3 To 6
        t(1, j - 2) = t(1, j - 2) + rng(i, j)
        TT(1, j - 2) = TT(1, j - 2) + rng(i, j)
      Next j
    Else
      rng(i, 3).Resize(, 4) = t
      rng(i, 3).Resize(, 4).Font.Bold = True
      ReDim t(1 To 1, 1 To 4)
    End If
  Next i
  sh.Range("C5").Resize(, 4) = TT
End Sub

www.giaiphapexcel.com/diendan/threads/gi%C3%BAp-%C4%91%E1%BB%A1-t%C3%ADnh-t%E1%BB%95ng-b%E1%BA%B1ng-vba.163525/

Thêm vài dòng lệnh từ ý tưởng của #07:

Sub ABC_1()
Dim Sh As Worksheet, Rng As Range, TT(), t(), SoDg&, I&, J&, Col As Integer

Set Sh = ThisWorkbook.Sheets("VP_2")
Set Rng = Sh.Range("A6:F" & Sh.Range("A1000000").End(xlUp).Row)
SoDg = Rng.Rows.Count
ReDim TT(1 To 1, 1 To 4)
ReDim t(1 To 1, 1 To 4)
For I = SoDg To 1 Step -1
If IsNumeric(Rng(I, 1).Value) Then
For J = 3 To 6
t(1, J – 2) = t(1, J – 2) + Rng(I, J)
' TT(1, J – 2) = TT(1, J – 2) + Rng(I, J) '
Next J
Else
Rng(I, 3).Resize(, 4) = t
Rng(I, 3).Resize(, 4).Font.Bold = True
For Col = 1 To 4
TT(1, Col) = TT(1, Col) + t(1, Col)
Next Col
ReDim t(1 To 1, 1 To 4)
End If
Next I
Sh.Range("C5").Resize(, 4) = TT
End Sub