Sub Loc()
Dim sArr(), dArr(), Dic As Object, I As Long, K As Long, Ngay As Long
Set Dic = CreateObject("Scripting.Dictionary")
With Sheets("BanHang")
sArr = .Range(.[B7], .[B65536].End(3)).Resize(, 13).Value
End With
ReDim dArr(1 To UBound(sArr), 1 To 5)
Ngay = Sheets("TongKet").[C3].Value
For I = 1 To UBound(sArr)
If sArr(I, 1) = Ngay Then
If Left(sArr(I, 13), 2) = "Tr" Then
If Not Dic.Exists(sArr(I, 3)) Then
K = K + 1
Dic.Add sArr(I, 3), K
dArr(K, 1) = K
dArr(K, 2) = sArr(I, 5)
dArr(K, 3) = sArr(I, 3)
dArr(K, 4) = sArr(I, 11)
dArr(K, 5) = sArr(I, 12)
Else
dArr(Dic.Item(sArr(I, 3)), 4) = dArr(Dic.Item(sArr(I, 3)), 4) + sArr(I, 11)
End If
End If
End If
Next
With Sheets("TongKet")
.[A6:D1000].ClearContents
If K Then .[A6].Resize(K, 5) = dArr
End With
Set Dic = Nothing
End Sub