Public Sub GPE()
Dim Rng(), Dic1 As Object, Dic2 As Object, I As Long, J As Long, K As Long, Dat As Variant, t As Variant
Dim Arr(1 To 65000, 1 To 240), Cot As Long, Ws As Worksheet, Tem As Variant, Dong, TS As Long
t = Timer
Set Dic1 = CreateObject("Scripting.Dictionary")
Set Dic2 = CreateObject("Scripting.Dictionary")
With Sheets("N-X XOP")
Rng = .Range(.[C8], .[C65000].End(xlUp)).Resize(, 3).Value
For I = 1 To UBound(Rng, 1)
K = I
Tem = Rng(I, 1)
If Not Dic1.Exists(Tem) Then
Dic1.Add Tem, I
Arr(I, 1) = Rng(I, 3)
For J = 4 To 240 Step 3
Arr(I, J) = "=SUM(RC[-3]:RC[-2])-RC[-1]"
Next J
End If
Next I
Rng = .[F6:IV6].Value
For I = 1 To UBound(Rng, 2)
Tem = Rng(1, I)
If Tem <> "" Then
Cot = I + 1
Dic2.Add Tem, Cot
End If
Next I
End With
Set Ws = Sheets("NHAN HANG XOP")
Rng = Ws.Range(Ws.[B11], Ws.[B65000].End(xlUp)).Resize(, 8).Value
For I = 1 To UBound(Rng, 1)
Dat = DateSerial(Year(Rng(I, 1)), Month(Rng(I, 1)), 1)
Cot = Dic2.Item(Dat)
If Cot > TS Then TS = Cot
If Dic1.Exists(Rng(I, 6)) Then
Tem = Rng(I, 6): Dong = Dic1.Item(Tem)
Arr(Dong, Cot) = Arr(Dong, Cot) + Rng(I, 8)
End If
Next I
Set Ws = Sheets("XUAT HANG XOP")
Rng = Ws.Range(Ws.[A11], Ws.[A65000].End(xlUp)).Resize(, 5).Value
For I = 1 To UBound(Rng, 1)
Dat = DateSerial(Year(Rng(I, 1)), Month(Rng(I, 1)), 1)
Cot = Dic2.Item(Dat) + 1
If Cot > TS Then TS = Cot
If Dic1.Exists(Rng(I, 3)) Then
Tem = Rng(I, 3): Dong = Dic1.Item(Tem)
Arr(Dong, Cot) = Arr(Dong, Cot) + Rng(I, 5)
End If
Next I
With Sheets("N-X XOP")
.[E8:IV10000].ClearContents
.[E8].Resize(K, TS + 1).Value = Arr
.[E8].Resize(K, TS + 1).Value = .[E8].Resize(K, TS + 1).Value
End With
Set Dic1 = Nothing: Set Dic2 = Nothing: Set Ws = Nothing
MsgBox Timer - t
End Sub