thì đấy tính tổng trước tháng chọnTồn kho tính dễ mà, nhập xuất thì sumif trong giai đoạn đó, còn tồn đầu thì sumif nhỏ hơn giai đoạn đó lấy nhập -xuất là ra thôi, tính toán số thì không khó dùng sumif là được, sợ chỗ lấy mã số hàng hóa không trùng hơi nặng với dữ liệu nhiều thôi.
Bài náy thiết kế gom 1 bảng thì thuận tiện cho VBA hơn, chứ công thức vẫn vậy.
VBA chỉ biết hơi hơi thôi,!!
gán giá trị 0 cho các ô trống, dùng format dạng số
Sub tonghop()
Dim InArr(), OutArr(), Arr(), i As Long, ik As Long, k As Long
Dim Dic As Object, Tmp
Dim Thang As Long, Nam As Long
With Sheets("Xem")
Thang = .Range("B2").Value
Nam = .Range("D2").Value
End With
Set Dic = CreateObject("Scripting.Dictionary")
With Sheets("Nhap")
InArr = .Range("A3", .Range("F65535").End(3)).Value2
End With
With Sheets("Xuat")
OutArr = .Range("A3", .Range("F65535").End(3)).Value2
End With
ReDim Arr(1 To UBound(InArr) + UBound(OutArr), 1 To 5)
For i = 1 To UBound(InArr)
If (Month(InArr(i, 1)) <= Thang And Year(InArr(i, 1)) = Nam) Or Year(InArr(i, 1)) < Nam Then
Tmp = InArr(i, 5)
If Not Dic.exists(Tmp) Then
k = k + 1
Dic.Add Tmp, k
Arr(k, 1) = Tmp: Arr(k, 2) = 0
Arr(k, 3) = 0: Arr(k, 4) = 0
End If
ik = Dic(Tmp)
If Month(InArr(i, 1)) = Thang And Year(InArr(i, 1)) = Nam Then
Arr(ik, 3) = Arr(ik, 3) + InArr(i, 6)
Arr(ik, 5) = Arr(ik, 5) + InArr(i, 6)
End If
If (Month(InArr(i, 1)) < Thang And Year(InArr(i, 1)) = Nam) Or Year(InArr(i, 1)) < Nam Then
Arr(ik, 2) = Arr(ik, 2) + InArr(i, 6)
Arr(ik, 5) = Arr(ik, 5) + InArr(i, 6)
End If
End If
Next i
For i = 1 To UBound(OutArr)
If (Month(OutArr(i, 1)) <= Thang And Year(OutArr(i, 1)) = Nam) Or Year(OutArr(i, 1)) < Nam Then
Tmp = OutArr(i, 5)
If Not Dic.exists(Tmp) Then
k = k + 1
Dic.Add Tmp, k
Arr(k, 1) = Tmp: Arr(k, 2) = 0
Arr(k, 3) = 0: Arr(k, 4) = 0
End If
ik = Dic(Tmp)
If Month(OutArr(i, 1)) = Thang And Year(OutArr(i, 1)) = Nam Then
Arr(ik, 4) = Arr(ik, 4) + OutArr(i, 6)
Arr(ik, 5) = Arr(ik, 5) - OutArr(i, 6)
End If
If (Month(OutArr(i, 1)) < Thang And Year(OutArr(i, 1)) = Nam) Or Year(OutArr(i, 1)) < Nam Then
Arr(ik, 2) = Arr(ik, 2) - OutArr(i, 6)
Arr(ik, 5) = Arr(ik, 5) - OutArr(i, 6)
End If
End If
Next i
With Sheets("Xem")
.Range("A5:E1000").Clear
If k Then
.Range("A5").Resize(k, 5) = Arr
.Range("B5").Resize(k, 4).NumberFormat = " #,##0.00 ; [red](#,##0.00) ; - "
.Range("A5").Resize(k, 5).Borders.LineStyle = 1
End If
End With
Set Dic = Nothing
End Sub
Anh Hiếu cho em hỏi tí, Anh hay dùng mấy hàm này Tarr(), Darr(), Sarr(), vậy mấy hàm này có ý nghĩa gì vậy Anh? Anh có thể nêu ví dụ minh họa được không?
Code ai người ấy sửa nhé.
Public Sub BC_Thang()
Dim Dic As Object, sArr(), dArr(1 To 1000, 1 To 8), I As Long, J As Long, K As Long, R As Long, Rws As Long, NgayDau As Long, NgayCuoi As Long, Tem As String
Set Dic = CreateObject("Scripting.Dictionary")
With Sheets("BCThang")
NgayDau = DateSerial(.Range("G2"), .Range("E2"), 1)
NgayCuoi = DateSerial(.Range("G2"), .Range("E2") + 1, 0)
End With
With Sheets("Nhap")
sArr = .Range("A3", .Range("A3").End(xlDown)).Resize(, 6).Value
R = UBound(sArr)
For I = 1 To R
Tem = sArr(I, 3) 'sArr(I, 5)'
If Not Dic.Exists(Tem) Then
K = K + 1: Dic.Add Tem, K
dArr(K, 1) = K: dArr(K, 2) = sArr(I, 3): dArr(K, 3) = sArr(I, 4): dArr(K, 4) = sArr(I, 5)
End If
Rws = Dic.Item(Tem)
If sArr(I, 1) < NgayDau Then
dArr(Rws, 5) = dArr(Rws, 5) + sArr(I, 6)
ElseIf sArr(I, 1) <= NgayCuoi Then
dArr(Rws, 6) = dArr(Rws, 6) + sArr(I, 6)
End If
Next I
End With
With Sheets("Xuat")
sArr = .Range("A3", .Range("A3").End(xlDown)).Resize(, 6).Value
R = UBound(sArr)
For I = 1 To R
Tem = sArr(I, 3) 'sArr(I, 5)'
If Not Dic.Exists(Tem) Then
K = K + 1: Dic.Add Tem, K
dArr(K, 1) = K: dArr(K, 2) = sArr(I, 3): dArr(K, 3) = sArr(I, 4): dArr(K, 4) = sArr(I, 5)
End If
Rws = Dic.Item(Tem)
If sArr(I, 1) < NgayDau Then
dArr(Rws, 5) = dArr(Rws, 5) - sArr(I, 6)
ElseIf sArr(I, 1) <= NgayCuoi Then
dArr(Rws, 7) = dArr(Rws, 7) + sArr(I, 6)
End If
Next I
End With
For I = 1 To K
dArr(I, 8) = dArr(I, 5) + dArr(I, 6) - dArr(I, 7)
Next I
With Sheets("BCThang")
.Range("A5:H1000").ClearContents
.Range("A5:H5").Resize(K) = dArr
End With
End SubTem = sArr(I, 3) '---------> sArr(I, 5)
