Sub tonghop()
Dim sArr(), tArr(), dArr(), I As Long, K As Long
Dim Dic As Object, Tem As String, R As Long
Dim Thang As Long, Nam As Long
Thang = Sheet3.Range("B2"): Nam = Sheet3.Range("D2")
Set Dic = CreateObject("Scripting.Dictionary")
With Sheet1
tArr = .Range("A3", .Range("F65535").End(3)).Value
End With
For I = 1 To UBound(tArr)
Tem = Month(tArr(I, 1)) & Year(tArr(I, 1)) & tArr(I, 5)
Dic.Item(Tem) = I
Next I
With Sheet2
sArr = .Range("A3", .Range("F65535").End(3)).Value
End With
ReDim dArr(1 To UBound(sArr), 1 To 5)
For I = 1 To UBound(sArr)
If Month(sArr(I, 1)) & Year(sArr(I, 1)) = Thang & Nam Then
Tem = Month(sArr(I, 1)) & Year(sArr(I, 1)) & sArr(I, 5)
R = Dic.Item(Tem)
If R Then
K = K + 1
dArr(K, 1) = tArr(R, 5)
dArr(K, 3) = tArr(R, 6)
dArr(K, 4) = sArr(R, 6)
dArr(K, 5) = dArr(K, 2) + dArr(K, 3) - dArr(K, 4)
End If
End If
Next I
With Sheet3
If K Then
.Range("A5:E1000").ClearContents
.Range("A5").Resize(K, 5) = dArr
End If
End With
Set Dic = Nothing
End Sub
