Sub Thongke()
Dim Dic As Object
Dim Arr_N(), Arr_M(), Res(), Rng_D As Range
Dim Dcuoi As Long, Dcuoi2&, Tong1&, Tong2&, Tong3&
Dim i As Long, j As Long, k As Long, t&, tt&
Dcuoi = Sheet1.Range("A10000").End(xlUp).Row
Arr_N = Sheet1.Range("A3:U" & Dcuoi).Value
Dcuoi2 = Sheet2.Range("A10000").End(xlUp).Row
Arr_M = Sheet2.Range("A4:L" & Dcuoi2).Value
Set Dic = CreateObject("Scripting.Dictionary")
ReDim Res(1 To UBound(Arr_N) + UBound(Arr_M), 1 To 30)
For i = 1 To UBound(Arr_N, 1)
Tong1 = 0: Tong2 = 0: Tong3 = 0
Key = Arr_N(i, 1) & "#" & Arr_N(i, 2) & "#" & Arr_N(i, 3) & "#" & Arr_N(i, 4)
If Not Dic.Exists(Key) Then
k = k + 1
Dic.Add (Key), k
For j = 1 To 21
Res(k, j) = Arr_N(i, j)
If j > 5 Then Tong1 = Tong1 + Arr_N(i, j) ': Tong2 = Tong2 + Arr_N(i, j)
Next j
Res(k, 22) = Tong1
Res(k, 29) = Tong2
Res(k, 30) = Tong1 + Tong2
Else
t = Dic.Item(Key)
For j = 6 To 21
Res(t, j) = Res(t, j) + Arr_N(i, j)
Tong1 = Tong1 + Arr_N(i, j)
Next j
Res(t, 22) = Res(t, 22) + Tong1
Res(t, 29) = Res(t, 29) + Tong2
Res(t, 30) = Res(t, 30) + Tong1 + Tong2
End If
Next
For i = 1 To UBound(Arr_M, 1)
Tong1 = 0: Tong2 = 0: Tong3 = 0
Key = Arr_M(i, 1) & "#" & Arr_M(i, 2) & "#" & Trim(Arr_M(i, 3)) & "#" & Arr_M(i, 4)
If Not Dic.Exists(Key) Then
k = k + 1
Dic.Add (Key), k
For j = 1 To 4
Res(k, j) = Arr_M(i, j)
Next j
For j = 7 To 12
Res(k, j + 16) = Arr_M(i, j)
Tong2 = Tong2 + Arr_M(i, j)
Next j
Res(k, 29) = Tong2
Res(k, 30) = Tong1 + Tong2
Else
tt = Dic.Item(Key)
For j = 7 To 12
Res(tt, j + 16) = Res(tt, j + 16) + Arr_M(i, j)
Tong2 = Tong2 + Arr_M(i, j)
Next j
Res(tt, 29) = Res(tt, 29) + Tong2
Res(tt, 30) = Res(tt, 30) + Tong1 + Tong2
End If
Next
If k Then
Sheet3.Range("A2:AA100000").ClearContents
Sheet3.Range("A2").Resize(k, 30) = Res
End If
Set Dic = Nothing
MsgBox "Done"
End Sub