Private Sub NutBaocao_Click()
Dim fDat As Date, lDat As Date, SoNgay As Integer, J As Long, W As Long, SN As Integer
Dim DongN As Long
Dim RgN As Range, ShN As Worksheet, ArrN(), ShX As Worksheet, ArrX()
ReDim dArr(1 To 356, 1 To 5)
fDat = TxtToDate(Me!txtTuNgay.Text): lDat = TxtToDate(Me!txtDenNgay.Text)
If fDat < 999 Then Exit Sub
SoNgay = lDat - fDat
Set ShN = ThisWorkbook.Worksheets("Nhap"): Set ShX = ThisWorkbook.Worksheets("Xuat")
ArrN() = ShN.Range(ShN.[b1], ShN.[b1].End(xlDown)).Value
For J = 2 To UBound(ArrN()) 'Xác Dinh Dòng Có Mã Hàng Nhâp: '
If ArrN(J, 1) = Me.cobHangXuat.Text Then
DongN = J: Exit For
End If
Next J
ArrN() = ShN.Range(ShN.[e1], ShN.[e1].End(xlToRight))
ArrX() = ShX.[c2].Resize(ShX.[c2].CurrentRegion.Rows.Count, 10).Value
For SN = 0 To SoNgay
1 'Nhâp Hàng '
For J = 1 To UBound(ArrN(), 2)
If ArrN(1, J) = SN + fDat Then
If ShN.Cells(DongN, J + 4).Value > 0 Then
W = W + 1: dArr(W, 1) = W
dArr(W, 2) = SN + fDat
dArr(W, 3) = ShN.Cells(DongN, J + 4).Value
If W = 1 Then
dArr(W, 5) = dArr(W, 3)
ElseIf W > 1 Then
dArr(W, 5) = dArr(W - 1, 5) + dArr(W, 3)
End If
Exit For
End If
End If
Next J
2 ' Xuát Hàng '
For J = 1 To UBound(ArrX())
If ArrX(J, 1) = SN + fDat And ArrX(J, 7) = Me!cobHangXuat.Text Then
W = W + 1: dArr(W, 1) = W
dArr(W, 2) = SN + fDat: dArr(W, 4) = ArrX(J, 10)
If W = 1 Then
dArr(W, 5) = -1 * dArr(W, 4)
ElseIf W > 1 Then
dArr(W, 5) = dArr(W - 1, 5) - dArr(W, 4)
End If
End If
Next J
Next SN
If W Then
Me!lbXuat.List = dArr()
End If
End Sub
Function TxtToDate(StrC As String) As Date
Dim Nm As Long, Th As Byte, Ng As Byte, VTr As Byte
If Len(StrC) < 8 Then Exit Function
Nm = CLng(Right(StrC, 4))
VTr = InStr(StrC, "/")
If VTr Then
Ng = CByte(Left(StrC, VTr - 1)): StrC = Mid(StrC, VTr + 1, 4)
End If
VTr = InStr(StrC, "/")
If VTr Then Th = CByte(Left(StrC, VTr - 1))
TxtToDate = DateSerial(Nm, Th, Ng)
End Function
