Public Sub Ton()
Dim Narr(), Xarr(), Arr(), i As Long, k As Long, R As Long, Tmp As String
With CreateObject("Scripting.Dictionary")
With Sheets("Nhap")
Narr = .Range("B2", .Range("B2").End(xlDown)).Resize(, 4).Value
End With
With Sheets("Xuat")
Xarr = .Range("D2", .Range("D2").End(xlDown)).Resize(, 4).Value
End With
ReDim Arr(1 To UBound(Narr) + UBound(Xarr), 1 To 6)
For i = 1 To UBound(Narr)
Tmp = Narr(i, 1) & "#" & Narr(i, 2) & "#" & Narr(i, 4)
If Not .Exists(Tmp) Then
k = k + 1: .Add Tmp, k
Arr(k, 1) = Narr(i, 1): Arr(k, 2) = Narr(i, 2)
Arr(k, 3) = Narr(i, 3): Arr(k, 5) = Narr(i, 3)
Arr(k, 6) = Narr(i, 4)
Else
R = .Item(Tmp)
Arr(R, 3) = Arr(R, 3) + Narr(i, 3)
Arr(R, 5) = Arr(R, 3)
End If
Next i
For i = 1 To UBound(Xarr)
Tmp = Xarr(i, 1) & "#" & Xarr(i, 2) & "#" & Xarr(i, 4)
If Not .Exists(Tmp) Then
k = k + 1: .Add Tmp, k
Arr(k, 1) = Xarr(i, 1): Arr(k, 2) = Xarr(i, 2)
Arr(k, 4) = Xarr(i, 3): Arr(k, 5) = Arr(k, 5) - Xarr(i, 3)
Arr(k, 6) = Xarr(i, 4)
Else
R = .Item(Tmp)
Arr(R, 4) = Arr(R, 4) + Xarr(i, 3)
Arr(R, 5) = Arr(R, 5) - Xarr(i, 3)
End If
Next i
End With
With Sheets("Ton")
.Range("A2:F10000").ClearContents
.Range("A2").Resize(k, 6) = Arr
End With
End Sub
Public Sub TongHop()
Dim Narr(), Xarr(), Arr(), i As Long, k As Long, R As Long, Tmp As String
With CreateObject("Scripting.Dictionary")
With Sheets("Nhap")
Narr = .Range("B2", .Range("B2").End(xlDown)).Resize(, 3).Value
End With
With Sheets("Xuat")
Xarr = .Range("D2", .Range("D2").End(xlDown)).Resize(, 3).Value
End With
ReDim Arr(1 To UBound(Narr) + UBound(Xarr), 1 To 5)
For i = 1 To UBound(Narr)
Tmp = Narr(i, 1) & "#" & Narr(i, 2)
If Not .Exists(Tmp) Then
k = k + 1: .Add Tmp, k
Arr(k, 1) = Narr(i, 1): Arr(k, 2) = Narr(i, 2)
Arr(k, 3) = Narr(i, 3): Arr(k, 5) = Narr(i, 3)
Else
R = .Item(Tmp)
Arr(R, 3) = Arr(R, 3) + Narr(i, 3)
Arr(R, 5) = Arr(R, 3)
End If
Next i
For i = 1 To UBound(Xarr)
Tmp = Xarr(i, 1) & "#" & Xarr(i, 2)
If Not .Exists(Tmp) Then
k = k + 1: .Add Tmp, k
Arr(k, 1) = Xarr(i, 1): Arr(k, 2) = Xarr(i, 2)
Arr(k, 4) = Xarr(i, 3): Arr(k, 5) = Arr(k, 5) - Xarr(i, 3)
Else
R = .Item(Tmp)
Arr(R, 4) = Arr(R, 4) + Xarr(i, 3)
Arr(R, 5) = Arr(R, 5) - Xarr(i, 3)
End If
Next i
End With
With Sheets("TongHop")
.Range("A2:E10000").ClearContents
.Range("A2").Resize(k, 5) = Arr
End With
End Sub