Option Explicit
Public Const THVBA As String = "https://tuhocvba.net/threads/thu-suc-cung-nhap-xuat-ton.1646/"
Public Sub Inventory()
Dim Data As Variant, Result As Variant, aInventory As Variant
Dim Total(1 To 1, 1 To 4)
Dim sKey As String, sItemCode As String, sInOut As String
Dim Quantity As Double, Tmr As Double
Dim i As Long, j As Long, k As Long, n As Long, c As Long, r As Long
Dim issueDate As Date
Dim shResult As Worksheet
On Error Resume Next
Set shResult = ThisWorkbook.Worksheets("Result")
If (Err.Number <> 0) Then
MsgBox "Not found sheet name ""Result"" in thisWorkbook.", vbCritical, THVBA
Exit Sub
End If
On Error GoTo 0
Const startDate As Date = #8/1/2021# '<<--- Ngay bat dau
Const endDate As Date = #8/31/2021# '<<--- Ngay ket thuc
Const sReceived As String = "N"
Const Delim As String = "|"
Tmr = Timer()
Data = ThisWorkbook.Worksheets("DATABASE").Range("A1").CurrentRegion.Value
If Not IsArray(Data) Then Exit Sub
r = UBound(Data, 1)
c = UBound(Data, 2)
ReDim Result(1 To r, 1 To c)
ReDim aInventory(1 To r, 1 To 6)
Dim dict As New Scripting.Dictionary
k = 1 '//Tieu de
aInventory(k, 1) = "STT"
aInventory(k, 2) = "ID"
aInventory(k, 3) = "DAU KY"
aInventory(k, 4) = "NHAP KHO"
aInventory(k, 5) = "XUAT KHO"
aInventory(k, 6) = "TON KHO"
k = 2 '// Total
aInventory(k, 2) = "SUM:"
For i = 2 To r
sItemCode = Data(i, 2)
sInOut = Data(i, 6)
issueDate = Data(i, 7)
Quantity = Data(i, 8)
If (issueDate <= endDate) Then
If Not dict.Exists(sItemCode) Then
k = k + 1
dict.Add sItemCode, k
aInventory(k, 1) = k - 2
aInventory(k, 2) = sItemCode
If (issueDate < startDate) Then
If sInOut = sReceived Then '// Nhap
aInventory(k, 3) = aInventory(k, 3) + Quantity '// Cong dau ky
Else '// Xuat
aInventory(k, 3) = aInventory(k, 3) - Quantity '// Tru dau ky
sKey = sItemCode & Delim & sInOut '// Kiem tra phat sinh nhap xuat
If Not dict.Exists(sKey) Then dict.Add sKey, issueDate
End If
Else '// Phat sinh trong khoang startDate den endDate
If sInOut = sReceived Then '// Nhap
aInventory(k, 4) = aInventory(k, 4) + Quantity '// Nhap kho
Else '// Xuat
aInventory(k, 5) = aInventory(k, 5) + Quantity '// Xuat kho
End If
End If
Else
n = dict.Item(sItemCode)
If (issueDate < startDate) Then
If sInOut = sReceived Then '// Nhap
aInventory(n, 3) = aInventory(n, 3) + Quantity '// Cong dau ky
Else '// Xuat
aInventory(n, 3) = aInventory(n, 3) - Quantity '// Tru dau ky
sKey = sItemCode & Delim & sInOut '// Kiem tra phat sinh nhap xuat
If Not dict.Exists(sKey) Then dict.Add sKey, issueDate
End If
Else '// Phat sinh trong khoang startDate den endDate
If sInOut = sReceived Then '// Nhap
aInventory(n, 4) = aInventory(n, 4) + Quantity '// Nhap kho
Else '// Xuat
aInventory(n, 5) = aInventory(n, 5) + Quantity '// Xuat kho
End If
End If
End If
End If
Next i
For i = 3 To k '// TON KHO
aInventory(i, 6) = aInventory(i, 3) + aInventory(i, 4) - aInventory(i, 5)
For j = 3 To 6
Total(1, j - 2) = Total(1, j - 2) + aInventory(i, j)
Next j
Next i
'---------------------> Phat sinh trong ky <-------------------------------
n = 1
'//Tieu de
For j = LBound(Data, 2) To UBound(Data, 2)
Result(n, j) = Data(1, j)
Next j
For i = 2 To r
sItemCode = Data(i, 2)
If sItemCode = "25" Then
Debug.Print
End If
sInOut = Data(i, 6)
issueDate = Data(i, 7)
If dict.Exists(sItemCode) Then Quantity = aInventory(dict.Item(sItemCode), 6)
sKey = sItemCode & Delim & "X" '// Kiem tra phat sinh nhap xuat
If (Not dict.Exists(sKey)) Or (Quantity > 0) Or (issueDate >= startDate And issueDate <= endDate) Then
n = n + 1
For j = 1 To c
Result(n, j) = Data(i, j)
Next j
End If
Next i
shResult.Cells.ClearContents
shResult.Range("A1").Resize(k, UBound(aInventory, 2)).Value = aInventory
shResult.Range("C2").Resize(, UBound(Total, 2)).Value = Total
shResult.Range("I1").Resize(n, UBound(Result, 2)).Value = Result
MsgBox "Successful ending,waiting time is: " & Round(Timer() - Tmr, 2) & " second", vbInformation, THVBA
End Sub
