Sub TongHop()
Application.ScreenUpdating = False
Dim MyRange As Range
Dim loai As String, sttloai As Byte, bando As Integer
Sheets("DATA").Select
Cells(1, 7).MergeCells = False
Columns("I:IV").MergeCells = False
rc = Cells(1, 1).End(xlDown).Row
bandomax = Application.WorksheetFunction.Max(Range(Cells(2, 1), Cells(rc, 1)))
Range(Cells(1, 4), Cells(rc, 4)).AdvancedFilter Action:=xlFilterCopy, CopyToRange:=Cells(2, 9), Unique:=True
r = 4: c = 10
Do While Cells(r, 9) <> ""
Cells(3, c) = Cells(r, 9)
c = c + 1
r = r + 1
Loop
cc = c - 1
Range(Cells(4, 6), Cells(65536, 256)).Clear
Set MyRange = Range(Cells(3, 9), Cells(3, cc))
For r = 1 To bandomax
Cells(r + 3, 6) = r
Next
For r = 2 To rc
bando = Cells(r, 1)
loai = Cells(r, 4)
Cells(3 + bando, 7) = Cells(3 + bando, 7) + Cells(r, 3)
Cells(3 + bando, 8) = Cells(3 + bando, 8) + Cells(r, 2)
sttloai = Application.WorksheetFunction.Match(loai, MyRange, 0)
If Err.Number > 0 Then
MsgBox "Khong co loai dat " & loai
Cells(r, 4).Select
Err.Number = 0
Exit Sub
Else
Cells(3 + bando, 8 + sttloai) = Cells(3 + bando, 8 + sttloai) + Cells(r, 3)
End If
Next
'Tong hop
For c = 7 To cc
Cells(4 + bando, c) = Application.WorksheetFunction.Sum(Range(Cells(4, c), Cells(3 + bando, c)))
Next
'Ke khung dinh dang
Set MyRange = Range(Cells(2, 6), Cells(4 + bandomax, cc))
MyRange.Borders(xlEdgeLeft).LineStyle = xlContinuous
MyRange.Borders(xlEdgeTop).LineStyle = xlContinuous
MyRange.Borders(xlEdgeBottom).LineStyle = xlContinuous
MyRange.Borders(xlEdgeRight).LineStyle = xlContinuous
MyRange.Borders(xlInsideVertical).LineStyle = xlContinuous
MyRange.Borders(xlInsideHorizontal).LineStyle = xlContinuous
MyRange.NumberFormat = "#,##0"
Cells(4 + bando, 6) = "T" & ChrW(7893) & "ng c" & ChrW(7843) & " xã"
Range(Cells(1, 6), Cells(3, cc)).Font.Bold = True
Range(Cells(4 + bando, 6), Cells(4 + bando, cc)).Font.Bold = True
Range(Cells(1, 7), Cells(1, cc)).MergeCells = True
Range(Cells(2, 9), Cells(2, cc)).MergeCells = True
Range(Cells(1, 7), Cells(3, cc)).HorizontalAlignment = xlCenter
Range(Cells(1, 7), Cells(2, cc)).EntireColumn.AutoFit
Cells(1, 1).Select
End Sub
