Sub SumAndGroup()
Dim iLop As Integer, jCot As Integer, kTo As Integer, n As Integer, Lr As Integer, Lcol As Integer
Dim Arr(), Diem_Lop As Long, Diem_To As Long
reset ' Xoa du lieu cu
With Sheet1
Lr = .Range("B" & Rows.Count).End(xlUp).Row
Lcol = .Cells(6, Columns.Count).End(xlToLeft).Column
Arr = .Range("A2").Resize(Lr - 1, Lcol).Value
End With
'-------------------------------------------------------------------
For jCot = 3 To UBound(Arr, 2)
For iLop = 1 To UBound(Arr, 1) - 2
If WorksheetFunction.IsText(Arr(iLop, 1)) Then
For kTo = iLop + 1 To UBound(Arr, 1) - 1
If IsNumeric(Arr(kTo, 1)) And Arr(kTo, 1) <> "" Then
For n = kTo + 1 To UBound(Arr, 1)
If Arr(n, 1) = "" Then
Diem_To = Diem_To + Arr(n, jCot)
ElseIf IsNumeric(Arr(n, 1)) Then
Arr(kTo, jCot) = Diem_To
Diem_Lop = Diem_Lop + Diem_To
Diem_To = 0
Exit For
Else
Arr(kTo, jCot) = Diem_To
Diem_Lop = Diem_Lop + Diem_To
Diem_To = 0
Arr(iLop, jCot) = Diem_Lop
Diem_Lop = 0
Exit For
End If
Next n
End If
If n > UBound(Arr, 1) Then
Arr(kTo, jCot) = Diem_To
Diem_Lop = Diem_Lop + Diem_To
Diem_To = 0
Arr(iLop, jCot) = Diem_Lop
Diem_Lop = 0
Exit For
End If
If IsNumeric(Arr(n, 1)) And Arr(n, 1) <> "" Then
kTo = n - 1
Else
iLop = n - 1
Exit For
End If
Next kTo
End If
Next iLop
Next jCot
Sheet1.Range("A2").Resize(Lr - 1, Lcol) = Arr
'----------------------------------------------------------
' To mau, group
For iLop = 1 To Lr
With Sheet1
If WorksheetFunction.IsText(.Range("A" & iLop)) Then
With .Range("A" & iLop).Resize(, Lcol).Interior
.ThemeColor = xlThemeColorAccent3
.TintAndShade = 0.599993896298105
End With
ElseIf IsNumeric(.Range("A" & iLop)) And .Range("A" & iLop) <> "" Then
With .Range("A" & iLop).Resize(, Lcol).Interior
.ThemeColor = xlThemeColorAccent5
.TintAndShade = 0.799981688894314
End With
For kTo = iLop + 1 To Lr
If IsNumeric(.Range("A" & kTo)) And .Range("A" & kTo) <> "" Or WorksheetFunction.IsText(.Range("A" & kTo)) Then
.Range(.Cells(iLop + 1, 1), .Cells(kTo - 1, 1)).Rows.Group
iLop = kTo - 1
Exit For
End If
Next kTo
End If
End With
Next iLop
MsgBox "Done", , "TuhocVBA.net"
End Sub