Option Explicit
Sub NXT2()
Dim eRow&, sRow&, i&, j&, k&, ik&
Dim aNhap(), aXuat(), res(), Dic As Object, iKey$
Dim fDay, eDay
sRow = Sheets("DanhMuc").Range("B" & Rows.count).End(xlUp).Row - 3
ReDim res(1 To sRow, 1 To 69)
With Sheets("NhapKho")
eRow = .Range("B" & Rows.count).End(xlUp).Row
If eRow >= 3 Then aNhap = .Range("B3:K" & eRow).Value
End With
With Sheets("XuatKho")
i = .Range("B" & Rows.count).End(xlUp).Row
If eRow < 3 And i < 3 Then MsgBox "Khong co du lieu nhap xuat", , "Thong Bao"
aXuat = .Range("B3:K" & i).Value
End With
With Sheets("BaoCaoNXT2")
fDay = .Range("F6").Value
eDay = .Range("F7").Value
If fDay = Empty Or eDay = Empty Or fDay > eDay Or IsDate(fDay) = False Or IsDate(eDay) = False Then
MsgBox "Chua nhap du thong tin ngay thang", , "Thong Bao"
Exit Sub
End If
End With
Set Dic = CreateObject("Scripting.Dictionary")
sRow = UBound(aNhap)
For i = 1 To sRow
iKey = aNhap(i, 6)
If Not Dic.Exists(iKey) Then
k = k + 1
Dic.Add iKey, k
res(k, 1) = k
For j = 2 To 5
res(k, j) = aNhap(i, j + 4)
Next j
End If
ik = Dic.Item(iKey)
If aNhap(i, 3) = "NKDK" Or aNhap(i, 1) < fDay Then
res(ik, 6) = res(ik, 6) + aNhap(i, 10)
res(ik, 69) = res(ik, 69) + aNhap(i, 10)
ElseIf aNhap(i, 1) <= eDay Then
j = 2 * (aNhap(i, 1) - fDay) + 7
res(ik, j) = res(ik, j) + aNhap(i, 10)
res(ik, 69) = res(ik, 69) + aNhap(i, 10)
End If
Next i
sRow = UBound(aXuat)
For i = 1 To sRow
iKey = aXuat(i, 6)
If Not Dic.Exists(iKey) Then
k = k + 1
Dic.Add iKey, k
res(k, 1) = k
For j = 2 To 5
res(k, j) = aXuat(i, j + 4)
Next j
End If
ik = Dic.Item(iKey)
If aXuat(i, 1) < fDay Then
res(ik, 6) = res(ik, 6) - aXuat(i, 10)
res(ik, 69) = res(ik, 69) - aXuat(i, 10)
ElseIf aXuat(i, 1) <= eDay Then
j = 2 * (aXuat(i, 1) - fDay) + 8
res(ik, j) = res(ik, j) + aXuat(i, 10)
res(ik, 69) = res(ik, 69) - aXuat(i, 10)
End If
Next i
Application.ScreenUpdating = False
Application.Calculation = xlCalculationManual
With Sheets("BaoCaoNXT2")
On Error Resume Next
.ShowAllData
On Error GoTo 0
.Range("B12:B1000").EntireRow.Hidden = False
.Range("B13:BR1000").ClearContents
If k > 0 Then .Range("B13").Resize(k, 69) = res
End With
MsgBox "Xong", , "Thong Bao"
Application.ScreenUpdating = True
Application.Calculation = xlCalculationAutomatic
End Sub
