Option Explicit
Sub Loc()
Dim DS As Range, MH As Range, KH As Range
Dim SL As Range, TempKH As Range, LocKH As Range
Dim Er As Long, i As Long
Dim Luu As Variant
Application.ScreenUpdating = False
Range("F1:I1000").Clear
Set DS = [A1].CurrentRegion
Set KH = DS.Resize(DS.Rows.Count, 1)
Set SL = KH.Offset(, 2)
Luu = DS.Value
DS.Sort Key1:=[A2], Order1:=1, Header:=1
DS.Copy Destination:=[F1]
Er = [G60000].End(xlUp).Row
Set LocKH = Range("F1:F" & Er)
For i = Er To 2 Step -1
Set TempKH = LocKH(i).Resize(1, 4)
If LocKH(i) = LocKH(i - 1) Then
LocKH(i).Clear
Else:
TempKH.Copy
TempKH.Insert Shift:=xlDown
LocKH(i + 1).Clear
With LocKH(i)
.Offset(, 1) = "Tong SP"
.Offset(, 2) = Application.WorksheetFunction.SumIf(KH, .Value, SL)
.Offset(, 3).Clear
.Resize(1, 4).Font.Bold = True
.Resize(1, 4).Font.ColorIndex = 5
.Resize(1, 4).Interior.ColorIndex = 35
End With
End If
Next i
With Range("G65000").End(xlUp).Offset(1, 0)
.Value = "TONG CONG"
.Font.Bold = True
.Offset(, 1) = Application.WorksheetFunction.Sum(SL)
.Resize(1, 2).Font.Bold = True
.Resize(1, 2).Font.ColorIndex = 3
End With
DS.Value = Luu
Application.ScreenUpdating = True
End Sub
