Option Explicit
Sub TongHop()
Dim i&, j&, t&, k&, LR&, LR1&, R&, R1&, sp&, p&
Dim Dic As Object, Key, DicSPG As Object, Temp
Dim Arr(), Arr1(), Res()
Dim Sh As Worksheet, Ws As Worksheet
Set Sh = Sheets("Data")
LR = Sh.Cells(Rows.Count, 1).End(3).Row
Arr = Sh.Range("A6:BC" & LR).Value: R = UBound(Arr)
Set Ws = Sheets("SPG tong hop")
LR1 = Ws.Cells(Rows.Count, 8).End(3).Row
Arr1 = Ws.Range("A10:N" & LR1).Value: R1 = UBound(Arr)
Set DicSPG = CreateObject("Scripting.Dictionary")
ReDim SPG(1 To R1, 1 To 2)
For i = 1 To R1
Key = Arr1(i, 8) & "|" & Arr1(i, 12) & "|" & Arr1(i, 13)
If Not DicSPG.Exists(Key) Then
sp = sp + 1: DicSPG.Add (Key), sp
SPG(sp, 1) = Key
SPG(sp, 2) = Arr1(i, 14)
Else
p = DicSPG.Item(Key)
SPG(p, 2) = SPG(p, 2) + Arr1(i, 14)
End If
Next i
Set Dic = CreateObject("Scripting.Dictionary")
ReDim Res(1 To UBound(Arr), 1 To 11)
For i = 1 To R
Key = Arr(i, 10) & "|" & Arr(i, 11) & "|" & Arr(i, 12) & "|" & Arr(i, 13)
Temp = Arr(i, 11) & "|" & Arr(i, 12) & "|" & Arr(i, 13)
If Not Dic.Exists(Key) Then
t = t + 1: Dic.Add (Key), t
Res(t, 1) = Arr(i, 10)
Res(t, 2) = Arr(i, 11)
Res(t, 3) = Arr(i, 12)
Res(t, 4) = Arr(i, 13)
If Arr(i, 2) = "TĐ" Then Res(t, 5) = Arr(i, 53)
If Arr(i, 3) = "N" Then Res(t, 6) = Arr(i, 53)
If Arr(i, 4) = "X" Then Res(t, 7) = Arr(i, 53)
Res(t, 8) = Res(t, 5) + Res(t, 6) - Res(t, 7)
If DicSPG.Exists(Temp) Then Res(t, 9) = SPG(DicSPG.Item(Temp), 2)
Res(t, 10) = Arr(i, 5)
Res(t, 11) = Arr(i, 55)
Else
k = Dic.Item(Key)
If Arr(i, 2) = "TĐ" Then Res(k, 5) = Res(k, 5) + Arr(i, 53)
If Arr(i, 3) = "N" Then Res(k, 6) = Res(k, 6) + Arr(i, 53)
If Arr(i, 4) = "X" Then Res(k, 7) = Res(k, 7) + Arr(i, 53)
Res(k, 8) = Res(k, 5) + Res(k, 6) - Res(k, 7)
End If
Next i
If t Then
Sheets("BC XNT").[B3].Resize(100000, 11).ClearContents
Sheets("BC XNT").[B3].Resize(t, 11) = Res
End If
Set Dic = Nothing: Set DicSPG = Nothing
MsgBox " Done"
End Sub
