Option Explicit
Public Sub GPE()
Dim Dic As Object, sArr, dArr, tArr, zArr, TCong
Dim I As Long, K As Long, N As Long, R As Long, T As Long
Set Dic = CreateObject("Scripting.Dictionary")
Application.ScreenUpdating = False
With Sheets("Sheet1")
.Sort.SortFields.Clear
sArr = .Range("A1", .Range("A1").End(4)).Resize(, 4).Value
ReDim dArr(1 To UBound(sArr), 1 To 500)
ReDim tArr(1 To UBound(sArr), 1 To 1)
ReDim zArr(1 To 1, 1 To 1000)
K = 1: N = 1
dArr(K, 1) = "Ngày": tArr(1, 1) = "Grand Total": zArr(1, 1) = "Grand Total"
For I = 2 To UBound(sArr)
If sArr(I, 1) >= .Range("O2").Value And sArr(I, 1) <= .Range("Q2").Value Then
If Not Dic.Exists(sArr(I, 3)) Then
N = N + 1
dArr(1, N) = sArr(I, 3)
Dic.Add sArr(I, 3), N
End If
If Not Dic.Exists(sArr(I, 1)) Then
K = K + 1
Dic.Add sArr(I, 1), K
dArr(K, 1) = sArr(I, 1)
End If
R = Dic.Item(sArr(I, 1))
T = Dic.Item(sArr(I, 3))
dArr(R, T) = dArr(R, T) + sArr(I, 4)
tArr(R, 1) = tArr(R, 1) + sArr(I, 4)
zArr(1, T) = zArr(1, T) + sArr(I, 4)
TCong = TCong + sArr(I, 4)
End If
Next I
zArr(1, N + 1) = TCong
.Range("N3").CurrentRegion.Offset(2).ClearContents
.Range("N3").CurrentRegion.Offset(2).Borders.LineStyle = 0
.Range("N3").Resize(K, N).Value = dArr
.Range("N3").Offset(, N).Resize(K).Value = tArr
.Range("N3").Offset(K).Resize(, N + 1).Value = zArr
.Range("N3").Resize(K + 1, N + 1).Borders.LineStyle = 1
.Range("N4").Resize(K - 1, N + 1).Sort .Range("N4")
With .Sort
.SortFields.Clear
.SortFields.Add Key:=Range("O3").Resize(, N - 1)
.SetRange Range("O3").Resize(K + 1, N - 1)
.Orientation = xlLeftToRight
.Apply
End With
End With
Application.ScreenUpdating = True
Set Dic = Nothing
End Sub
