Sub tinhsoluong()
Dim i As Long, lr As Long, dic As Object, arr, data, kq() As Double, a As Long, dk As String, b As Long, ngaybd As Long, ngaykt As Long
Set dic = CreateObject("scripting.dictionary")
With Sheets("NXT")
lr = .Range("A" & Rows.Count).End(xlUp).Row
arr = .Range("A4:B" & lr).Value
ngaybd = .Range("o2").Value2
ngaykt = .Range("R2").Value2
For i = 1 To UBound(arr)
dk = arr(i, 1)
If Not dic.exists(dk) Then
dic.Add dk, i
End If
Next i
ReDim kq(1 To UBound(arr), 1 To 8)
End With
With Sheets("Nhap")
lr = .Range("A" & Rows.Count).End(xlUp).Row
arr = .Range("A3:i" & lr).Value
For i = 1 To UBound(arr)
If CLng(arr(i, 2)) < ngaybd Then
dk = arr(i, 4)
a = dic.Item(dk)
If a Then
kq(a, 1) = kq(a, 1) + arr(i, 7)
kq(a, 2) = kq(a, 2) + arr(i, 9)
kq(a, 7) = kq(a, 1) + kq(a, 3)
kq(a, 8) = kq(a, 2) + kq(a, 4)
End If
ElseIf CLng(arr(i, 2)) <= ngaykt Then
dk = arr(i, 4)
a = dic.Item(dk)
If a Then
kq(a, 3) = kq(a, 3) + arr(i, 7)
kq(a, 4) = kq(a, 4) + arr(i, 9)
kq(a, 7) = kq(a, 1) + kq(a, 3)
kq(a, 8) = kq(a, 2) + kq(a, 4)
End If
End If
Next i
End With
With Sheets("Xuat")
lr = .Range("A" & Rows.Count).End(xlUp).Row
arr = .Range("A3:K" & lr).Value
For i = 1 To UBound(arr)
If CLng(arr(i, 2)) < ngaybd Then
dk = arr(i, 6)
a = dic.Item(dk)
If a Then
kq(a, 1) = kq(a, 1) - arr(i, 9)
kq(a, 2) = kq(a, 2) - arr(i, 11)
kq(a, 7) = kq(a, 1) + kq(a, 3) - kq(a, 5)
kq(a, 8) = kq(a, 2) + kq(a, 4) - kq(a, 6)
End If
ElseIf CLng(arr(i, 2)) <= ngaykt Then
dk = arr(i, 6)
a = dic.Item(dk)
If a Then
kq(a, 5) = kq(a, 5) + arr(i, 9)
kq(a, 6) = kq(a, 6) + arr(i, 11)
kq(a, 7) = kq(a, 1) + kq(a, 3) - kq(a, 5)
kq(a, 8) = kq(a, 2) + kq(a, 4) - kq(a, 6)
End If
End If
Next i
End With
With Sheets("NXT")
.Range("D4:K4").Resize(UBound(kq)).Value = kq
End With
Set dic = Nothing
End Sub
