Sub PhieuXuat()
Dim aTon(), aDDH(), Res()
Dim i&, r&, r2&, k&, sRow&
Dim sNhap#, sXuat#
Dim Ma$, MaP$, Lot, Kho$, Ke&
With Sheets("FIFO2")
i = .Range("T" & Rows.Count).End(xlUp).Row
If i > 4 Then Range("T5:Z" & i).ClearContents 'Xóa du lieu
i = .Range("L" & Rows.Count).End(xlUp).Row
If i < 5 Then MsgBox ("Khong co du lieu"): Exit Sub
aDDH = .Range("L5:P" & i).Value 'Don dat hang
i = .Range("C" & Rows.Count).End(xlUp).Row
If i < 5 Then MsgBox ("Khong co du lieu"): Exit Sub
Res = .Range("C5:H" & i).Value
.Range("C5:H" & i).Sort .[C5], 1, .[H5], , 1, Header:=xlNo
aTon = .Range("C5:H" & i).Value 'Hàng ton kho
.Range("C5:H" & i).Value = Res
End With
ReDim Res(1 To 50, 1 To 6)
sRow = UBound(aDDH)
For i = 1 To sRow
Ma = aDDH(i, 1): MaP = aDDH(i, 2): Lot = aDDH(i, 3)
Kho = aDDH(i, 4): sXuat = aDDH(i, 5)
tmp = ""
If Ma <> Empty Then
For r = 1 To UBound(aTon)
If aTon(r, 1) = Ma Then
For r2 = r To UBound(aTon)
If aTon(r2, 1) <> Ma Then Exit For '***
sNhap = aTon(r2, 6)
If sNhap > 0 Then
If aTon(r2, 2) = MaP Or MaP = Empty Then
If aTon(r2, 3) = Lot Or Lot = Empty Then
If aTon(r2, 4) = Kho Or Kho = Empty Then
k = k + 1
Res(k, 1) = Ma: Res(k, 2) = MaP: Res(k, 3) = aTon(r2, 3)
Res(k, 4) = Kho: Res(k, 5) = aTon(r2, 5)
If sNhap >= sXuat Then
Res(k, 6) = sXuat
sXuat = 0
Exit For '***
Else
Res(k, 6) = sNhap
sXuat = sXuat - sNhap
End If
End If
End If
End If
End If
Next r2
If sXuat > 0 Then
k = k + 1
Res(k, 1) = Ma: Res(k, 2) = MaP: Res(k, 3) = Lot: Res(k, 4) = Kho
Res(k, 6) = "Thieu " & sXuat
End If
Exit For '***
End If
Next r
End If
Next i
Sheets("FIFO2").Range("T5").Resize(k, 6) = Res
End Sub
Sub XuatKho()
Dim aTon(), aXuat(), Dic As Object, Ke$
Dim i&, ik&, sRow&
With Sheets("FIFO2")
i = .Range("T" & Rows.Count).End(xlUp).Row
If i < 5 Then MsgBox ("Khong co du lieu"): Exit Sub
aXuat = .Range("T5:Y" & i).Value 'Phieu Xuat
i = .Range("C" & Rows.Count).End(xlUp).Row
If i < 5 Then MsgBox ("Khong co du lieu"): Exit Sub
aTon = .Range("C5:H" & i).Value 'Hàng ton kho
'.Range("T5:Y" & i).PrintPreview 'Xem trang in
.Range("T5:Y" & i).PrintOut 'In Phieu xuat
Range("T5:Z" & i).ClearContents 'Xóa du lieu
End With
'Giam hang ton kho
Set Dic = CreateObject("scripting.dictionary")
sRow = UBound(aTon)
For i = 1 To sRow
If aTon(i, 5) <> Empty Then Dic.Item(aTon(i, 5)) = i
Next i
sRow = UBound(aXuat)
For i = 1 To sRow
ik = Dic.Item(aXuat(i, 5))
If ik > 0 Then
aTon(ik, 6) = aTon(ik, 6) - aXuat(i, 6)
End If
Next i
Sheets("FIFO2").Range("C5").Resize(UBound(aTon), 6) = aTon 'Giam hang ton kho
End Sub
.
