Sub NhapXuatTon()
Dim aNhap(), aXuat(), aDinhMuc(), TieuDe(), Res(), S
Dim SP$, NL$, iKey$, SoLuong As Double
Dim eRow&, eCol&, sRow&, sCol&, i&, ik&, j&, jk&, n&
Dim fDate&, eDate&, iDate&
fDate = 100000: eDate = 0
With Sheets("Nhap_NVL")
eRow = .Range("A" & Rows.Count).End(xlUp).Row
If eRow < 2 Then eRow = 2
aNhap = .Range("A2:C" & eRow).Value
iDate = Application.Min(.Range("A2:A" & eRow))
If fDate > iDate Then fDate = iDate
iDate = Application.Max(.Range("A2:A" & eRow))
If eDate < iDate Then eDate = iDate
End With
With Sheets("Xuat_SP")
eRow = .Range("A" & Rows.Count).End(xlUp).Row
If eRow < 2 Then eRow = 2
aXuat = .Range("A2:C" & eRow).Value
iDate = Application.Min(.Range("B2:B" & eRow))
If fDate > iDate Then fDate = iDate
iDate = Application.Max(.Range("B2:B" & eRow))
If eDate < iDate Then eDate = iDate
End With
With Sheets("DinhMuc")
eRow = .Range("A" & Rows.Count).End(xlUp).Row
If eRow < 2 Then eRow = 2
aDinhMuc = .Range("A2:C" & eRow).Value
End With
sCol = -1
With CreateObject("scripting.dictionary")
sRow = UBound(aDinhMuc)
For i = 1 To sRow
NL = aDinhMuc(i, 2)
If Len(NL) Then
If .exists(NL) = False Then
sCol = sCol + 3
.Add NL, sCol
ReDim Preserve TieuDe(1 To 1, 2 To sCol)
TieuDe(1, sCol) = NL
End If
End If
SP = "#" & aDinhMuc(i, 1) & "#"
If Len(SP) > 2 Then
iKey = SP & NL
If .exists(iKey) = False Then
.Item(SP) = .Item(SP) & "|" & NL
.Item(iKey) = aDinhMuc(i, 3)
End If
End If
Next i
sCol = sCol + 2
ReDim Res(fDate To eDate, 1 To sCol)
ReDim Res(1 To eDate - fDate + 1, 1 To sCol)
sRow = UBound(aNhap)
For i = 1 To sRow
ik = aNhap(i, 1)
jk = .Item(aNhap(i, 2))
Res(ik, jk) = Res(ik, jk) + aNhap(i, 3)
Next i
sRow = UBound(aXuat)
For i = 1 To sRow
ik = aXuat(i, 2)
SP = "#" & aXuat(i, 1) & "#"
S = .Item(SP)
If InStr(1, S, "|") Then
SoLuong = aXuat(i, 3)
S = Split(S, "|")
n = UBound(S)
For j = 1 To n
NL = S(j)
jk = .Item(NL) + 1 'Thu tu cot NL, cot xuat
iKey = SP & NL
Res(ik, jk) = Res(ik, jk) + .Item(SP & NL) * SoLuong
a = .Item(SP & NL)
Next j
End If
Next i
End With
For i = fDate To eDate
Res(i, 1) = CDate(i)
For j = 2 To sCol Step 3
Res(i, j + 2) = Res(i, j + 2) + Res(i, j) - Res(i, j + 1)
If i > fDate Then Res(i, j + 2) = Res(i, j + 2) + Res(i - 1, j + 2)
Next j
Next i
For i = fDate To eDate
For j = 2 To sCol Step 3
If Res(i, j) = Empty And Res(i, j + 1) = Empty Then Res(i, j + 2) = Empty
Next j
Next i
Application.ScreenUpdating = False
With Sheets("NXT_NL")
eRow = .Range("C" & Rows.Count).End(xlUp).Row
If eRow > 3 Then .Range("C4:AAA" & eRow).Clear
eCol = .Range("XCC2").End(xlToLeft).Column + 2
If eCol > 6 Then .Range("G2", Cells(3, eCol)).Clear
.Range("D2:F3").Copy
.Range("G2").Resize(2, sCol - 4).Select
.Paste
Application.CutCopyMode = False
.Range("D2").Resize(, sCol - 2) = TieuDe
sRow = eDate - fDate + 1
.Range("C4").Resize(sRow, sCol) = Res
.Range("C4").Resize(sRow, sCol).Borders.LineStyle = 1
.Range("D4").Resize(sRow, sCol - 1).NumberFormat = "#,##0_);[Red](#,##0)"
End With
Application.ScreenUpdating = True
End Sub
