Liệt kê sl và tiền tồn kho theo FIFO!

[ThuNghi]

Liệt kê sl và tiền tồn kho theo FIFO!
Tôi có dữ liệu như sau:

STT Ngày Loại Nhap Xuat Don Gia Nhap TienNhap
001 01/01/2011 Sim MB A 10 39,000 390,000
002 02/01/2011 Sim MB A 5 40,000 200,000
003 03/01/2011 Sim MB A 8 -
004 04/01/2011 Sim MB A 7 -
005 05/01/2011 Sim MB A 2 39,000 78,000
006 06/01/2011 Sim MB A 3 40,500 121,500
007 07/01/2011 Sim MB A 5 -
009 08/01/2011 Sim MB A 5 40,000 200,000
010 09/01/2011 Sim MB B 20 41,000 820,000
011 10/01/2011 Sim MB C 10 42,000 420,000
012 11/01/2011 Sim MB A 10 43,000 430,000
013 12/01/2011 Sim MB A 10 -
014 13/01/2011 Sim MB B 10 40,000 400,000
015 14/01/2011 Sim MB B 10 39,000 390,000
016 14/01/2011 Sim MB C 5 40,500 202,500
017 15/01/2011 Sim MB B 25 -
018 16/01/2011 Sim MB C 12 -
019 17/01/2011 Sim MB A 3 -
020 18/01/2011 Sim MB C 5 43,000 215,000
021 19/01/2011 Sim MB C 8 -
95 78 3,867,000

Nhờ các bạn viết cho 1 code để lấy số lượng tồn kho, số CT và đơn giá tồn kho.

SoPn Ngay MaHH SLTon DG TienTon
012 11/01/2011 Sim MB A 2 43,000 86,000
014 13/01/2011 Sim MB B 5 40,000 200,000
015 14/01/2011 Sim MB B 10 39,000 390,000
17 676,000

Cụ thể là từ sh Fifo tạo ra sh TonFiFo theo file kèm.
Xin cám ơn.

 

[ThuNghi]

Hỏi thì không bạn nào giúp, không hỏi thì sợ các bạn không có bài luyện code.
Thôi thì mình làm thử code và nhờ các bạn kiểm tra giúp xem có đúng chưa.
Code gán vào file trên.
Cái vụ lấy hàng tồn theo fifo này rất cần thiết khi chuyển số dư. Đỡ mất công phải tính lại từ đầu khi sang kỳ mới.
Xin cám ơn.

Option Explicit
Dim sMaHH As String, Dic As Object
Dim SL_Ton As Double, SL_Nhap As Double
Dim endR As Long, i As Long, j As Long, s As Long, t As Long, k As Long, iR As Long
Dim ArrData(), ArrTon(), ArrKQ(), ArrDataNh()
Const SoCTCol As Long = 1: Const NgCTCol As Long = 2: Const MaCol As Long = 3
Const SLNhapCol As Long = 4: Const SLXuatCol As Long = 5: Const DGNhapCol As Long = 6
Sub TonFiFo()
With Sheets("Fifo")
  endR = .Cells(65000, 1).End(xlUp).Row
  ArrData = .Range("A2:G" & endR).Value
End With
Set Dic = CreateObject("Scripting.Dictionary")
s = 0: t = 0
ReDim ArrTon(1 To UBound(ArrData), 1 To 2)
ReDim ArrDataNh(1 To UBound(ArrData), 1 To UBound(ArrData, 2))
For i = 1 To UBound(ArrData)
  sMaHH = ArrData(i, MaCol)
  If Not Dic.Exists(sMaHH) Then
    s = s + 1
    ArrTon(s, 1) = sMaHH
    Dic.Add sMaHH, s
  End If
  If Dic.Exists(sMaHH) Then
    iR = Dic.Item(sMaHH)
    ArrTon(iR, 2) = ArrTon(iR, 2) + ArrData(i, SLNhapCol) - ArrData(i, SLXuatCol)
  End If
  If ArrData(i, SLNhapCol) > 0 Then
    t = t + 1
    For k = 1 To UBound(ArrData, 2)
      ArrDataNh(t, k) = ArrData(i, k)
    Next k
  End If
Next i
Set Dic = Nothing: Erase ArrData
t = 0: ReDim ArrKQ(1 To UBound(ArrDataNh), 1 To 6)
For j = 1 To s
  If ArrTon(j, 2) > 0 Then
    sMaHH = ArrTon(j, 1)
    SL_Ton = ArrTon(j, 2)
    For i = UBound(ArrDataNh) To 1 Step -1
      If ArrDataNh(i, MaCol) = sMaHH Then
        SL_Nhap = ArrDataNh(i, SLNhapCol)
        t = t + 1
        ArrKQ(t, 1) = CStr(ArrDataNh(i, SoCTCol)) 'soct'
        ArrKQ(t, 2) = ArrDataNh(i, NgCTCol) 'Ngayct'
        ArrKQ(t, 3) = sMaHH
        If SL_Nhap >= SL_Ton Then
          ArrKQ(t, 4) = SL_Ton
          ArrKQ(t, 5) = ArrDataNh(i, DGNhapCol) 'DgNhap'
          ArrKQ(t, 6) = ArrKQ(t, 4) * ArrKQ(t, 5)
          Exit For
        Else
          ArrKQ(t, 4) = SL_Nhap
          ArrKQ(t, 5) = ArrDataNh(i, DGNhapCol) 'DgNhap'
          ArrKQ(t, 6) = ArrKQ(t, 4) * ArrKQ(t, 5)
          SL_Ton = SL_Ton - SL_Nhap
        End If
       End If
    Next i
  End If
Next j
With Sheets("TonFiFo")
  .[A2].Resize(t, 6) = ArrKQ
End With
Erase ArrData(), ArrTon(), ArrKQ()
End Sub

Xin tha lỗi cho cái chuyện tự hỏi và tự trả lời.