Option Explicit
Private Sub Worksheet_Change(ByVal Target As Range)
If Not Intersect(Target, Range("B3:C3")) Is Nothing Then
Dim Arr(), Res(1 To 10000, 1 To 5), i As Long, Lr1 As Long
Dim k As Long, Lr As Long, Dh As String, Smh As String
Dim Dic As Object, Key As String, Arr1(), a As Long, b As Long
On Error Resume Next
Application.DisplayAlerts = False
Application.ScreenUpdating = False
Set Dic = CreateObject("Scripting.Dictionary")
With Sheets("ChiTiet")
Dh = .Range("B3").Value
Smh = .Range("C3").Value
.Range("A6:E100000").Delete
End With
With Sheets("Xuat")
Lr = .Range("C" & Rows.Count).End(xlUp).Row
Arr = .Range("C2:O" & Lr).Value
For i = 1 To UBound(Arr)
If Arr(i, 3) = Dh And Arr(i, 4) = Smh Then
k = k + 1
Res(k, 1) = Arr(i, 1): Res(k, 2) = Arr(i, 2)
Res(k, 3) = Arr(i, 5): Res(k, 4) = Arr(i, 6)
Res(k, 5) = Arr(i, 9)
End If
Next i
End With
With Sheets("ChiTiet")
If k Then
.Range("A6").Resize(k, 5).Value = Res
Lr1 = .Range("A" & Rows.Count).End(xlUp).Row
With Range("A5:E" & Lr1)
.Sort .Cells(5, 3), 1, Header:=xlGuess
End With
Arr1 = .Range("C6:C" & Lr1).Value
For i = 1 To Lr1
Key = Arr1(i, 1)
If Not Dic.exists(Key) Then
b = b + 1
Dic.Add (Key), b
End If
Next i
a = Dic.Count
For i = 6 To Lr1 + a
If .Cells(i + 1, 3) <> .Cells(i, 3) Then
.Rows(i + 1).Insert
.Cells(i + 1, 4) = "TOTAL"
.Cells(i + 1, 4).HorizontalAlignment = xlRight
.Cells(i + 1, 4).Font.Bold = True
.Cells(i + 1, 4).Interior.ColorIndex = 27
.Cells(i + 1, 5) = WorksheetFunction.SumIf(.Range("C:C"), .Range("C" & i), .Range("E:E"))
.Cells(i + 1, 5).Font.Bold = True
.Cells(i + 1, 5).Font.ColorIndex = 3
.Cells(i + 1, 5).Interior.ColorIndex = 27
i = i + 1
End If
Next i
End If
.Range("A5").CurrentRegion.Borders.LineStyle = 1
End With
Application.DisplayAlerts = True
Application.ScreenUpdating = True
Set Dic = Nothing
End If
End Sub
