
ดูต้วอย่าง Code สำหรับการใส่ Subtotal, Grand Total ตามด้านล่างครับ
ส่วนการระบายสี Sub Total, Grand Total ลองเขียนมาเองก่อน ติดตรงไหนค่อยถามกันต่อครับ
Code: Select all
Dim grandTotal As Double
Sub Test()
Dim rAll As Range, r As Range
Dim colR As Collection, item As Variant
Dim subTotal As Double, target As Range
Dim iMax As Integer, iCount As Integer
Set colR = New Collection
With Sheets("NEWDATA")
Set rAll = .Range("a2", .Range("a" & Rows.Count).End(xlUp))
End With
On Error Resume Next
For Each r In rAll
colR.Add r, r
Next r
On Error GoTo 0
For Each item In colR
iMax = Application.CountIf(rAll, item)
iCount = 0
subTotal = 0
For Each r In rAll
If r <> "" Then
With Sheets("MPS TEMPLATE")
Set target = .Range("a" & Rows.Count).End(xlUp).Offset(1, 0)
End With
If r = item Then
target = r
target.Offset(0, 1) = r.Offset(0, 1)
subTotal = subTotal + r.Offset(0, 1)
iCount = iCount + 1
End If
If iCount = iMax Then
With Sheets("MPS TEMPLATE").Range("a" & Rows.Count).End(xlUp)
.Offset(1, 0) = "Sub Total"
.Offset(1, 1) = subTotal
End With
Exit For
End If
End If
Next r
GrandTotal = GrandTotal + subTotal
Next item
With Sheets("MPS TEMPLATE").Range("a" & Rows.Count).End(xlUp)
.Offset(1, 0) = "Grand Total"
.Offset(1, 1) = GrandTotal
End With
Set colR = Nothing
End Sub