Xin giúp đỡ sửa lại mã tính giá xuất kho theo phương pháp LIFO, FIFO

Liên hệ QC
M

mrbomst

Thành viên mới
Tham gia
20/11/19
Bài viết
49
Được thích
1
Kính gửi mọi người trên diễn đàn.
Em có tham khảo được 1 bài viết của bác #Huuthang trên diễn đàn về mã tính giá xuất kho theo các phương pháp và đã áp dụng được vào bảng tính của mình nhưng chỉ riêng 2 phương pháp là LIFO và FIFO khi chạy dữ liệu lại phát sinh lỗi mà em lại không biết là do đâu. em xin gửi file gốc đã thêm vào dữ liệu để chạy code. mong mọi người có thể sửa lại giúp em ạ!
Em xin cảm ơn mọi người!
Mã: 
Private Sub TinhGiaXK_BQGQThang()
Application.ScreenUpdating = False
Application.Calculation = xlCalculationManual
Dim ArrPhatSinh, ArrTest, ArrTonKho(), ArrViTri(), Dic, EndRow As Long, i As Long, j As Long, k As Long, l As Long, TaiKhoan As String, SoLuong As Double, SoLuongTon As Double, SoTien As Double, SoTienTon As Double, STT As Long, Gia As String
TaiKhoan = PhatSinh.[E2].Value
Set Dic = CreateObject("Scripting.Dictionary")
ArrPhatSinh = DauKy.Range("A3:E" & DauKy.[A65536].End(xlUp).Row + 1).Value
ReDim ArrTonKho(1 To 10000, 1 To 48)
For i = 1 To UBound(ArrPhatSinh, 1) - 1
    If ArrPhatSinh(i, 1) Like TaiKhoan & "*" Then
        j = j + 1
        Dic.Add ArrPhatSinh(i, 2) & vbBack & ArrPhatSinh(i, 3), j
        ArrTonKho(j, 1) = ArrPhatSinh(i, 5)
        ArrTonKho(j, 2) = ArrPhatSinh(i, 4)
    End If
Next
EndRow = PhatSinh.[A:K].Find(What:="*", LookIn:=xlFormulas, LookAt:=xlPart, SearchOrder:=xlByRows, SearchDirection:=xlPrevious).Row + 1
ArrPhatSinh = PhatSinh.Range("A5:K" & EndRow).Value
ArrTest = PhatSinh.Range("L5:L" & EndRow).Value
ReDim ArrViTri(1 To UBound(ArrPhatSinh), 1 To 3)
For i = 1 To UBound(ArrPhatSinh, 1)
    If ArrPhatSinh(i, 4) Like TaiKhoan & "*" And ArrPhatSinh(i, 7) <> "" Then
        If Not Dic.Exists(ArrPhatSinh(i, 6) & vbBack & ArrPhatSinh(i, 7)) Then
            j = j + 1
            Dic.Add ArrPhatSinh(i, 6) & vbBack & ArrPhatSinh(i, 7), j
        End If
        STT = CLng(Dic.Item(ArrPhatSinh(i, 6) & vbBack & ArrPhatSinh(i, 7)))
        ArrTonKho(STT, ArrPhatSinh(i, 1) * 4 - 3) = ArrTonKho(STT, ArrPhatSinh(i, 1) * 4 - 3) + ArrPhatSinh(i, 11)
        ArrTonKho(STT, ArrPhatSinh(i, 1) * 4 - 2) = ArrTonKho(STT, ArrPhatSinh(i, 1) * 4 - 2) + ArrPhatSinh(i, 10)
    End If
    If ArrPhatSinh(i, 5) Like TaiKhoan & "*" And ArrPhatSinh(i, 9) <> "" Then
        If Not Dic.Exists(ArrPhatSinh(i, 8) & vbBack & ArrPhatSinh(i, 9)) Then
            j = j + 1
            Dic.Add ArrPhatSinh(i, 8) & vbBack & ArrPhatSinh(i, 9), j
        End If
        STT = CLng(Dic.Item(ArrPhatSinh(i, 8) & vbBack & ArrPhatSinh(i, 9)))
        ArrTonKho(STT, ArrPhatSinh(i, 1) * 4 - 1) = ArrTonKho(STT, ArrPhatSinh(i, 1) * 4 - 1) + ArrPhatSinh(i, 10)
        k = k + 1
        ArrViTri(k, 1) = ArrPhatSinh(i, 8) & vbBack & ArrPhatSinh(i, 9)
        ArrViTri(k, 2) = ArrPhatSinh(i, 1)
        ArrViTri(k, 3) = i
    End If
Next
For i = 1 To j
    For l = 1 To 12
        If l > 1 Then
            ArrTonKho(i, l * 4 - 3) = ArrTonKho(i, l * 4 - 3) + (ArrTonKho(i, l * 4 - 6) - ArrTonKho(i, l * 4 - 5)) * ArrTonKho(i, l * 4 - 4)
            ArrTonKho(i, l * 4 - 2) = ArrTonKho(i, l * 4 - 2) + ArrTonKho(i, l * 4 - 6) - ArrTonKho(i, l * 4 - 5)
        End If
        If ArrTonKho(i, l * 4 - 2) = 0 Then
            ArrTonKho(i, l * 4) = 0
        Else
            ArrTonKho(i, l * 4) = ArrTonKho(i, l * 4 - 3) / ArrTonKho(i, l * 4 - 2)
        End If
    Next
Next
For i = 1 To k
    STT = CLng(Dic.Item(ArrViTri(i, 1)))
    ArrTest(ArrViTri(i, 3), 1) = Round(ArrTonKho(STT, ArrViTri(i, 2) * 4) * ArrPhatSinh(ArrViTri(i, 3), 10), 0)
Next
PhatSinh.Range("L5:L" & EndRow).Value = ArrTest
Application.Calculation = xlCalculationAutomatic
Application.ScreenUpdating = True
End Sub
Private Sub TinhGiaXK_BQGQNhap()
Application.ScreenUpdating = False
Application.Calculation = xlCalculationManual
Dim ArrPhatSinh, ArrTest, ArrTonKho(), Dic, EndRow As Long, i As Long, j As Long, TaiKhoan As String, SoLuong As Double, SoLuongTon As Double, SoTien As Double, SoTienTon As Double, STT As Long, Gia As String
TaiKhoan = PhatSinh.[E2].Value
Set Dic = CreateObject("Scripting.Dictionary")
ArrPhatSinh = DauKy.Range("A3:E" & DauKy.[A65536].End(xlUp).Row + 1).Value
ReDim ArrTonKho(1 To 10000, 1 To 2)
For i = 1 To UBound(ArrPhatSinh, 1) - 1
    If ArrPhatSinh(i, 1) Like TaiKhoan & "*" Then
        j = j + 1
        Dic.Add ArrPhatSinh(i, 2) & vbBack & ArrPhatSinh(i, 3), j
        ArrTonKho(j, 1) = ArrPhatSinh(i, 5)
        ArrTonKho(j, 2) = ArrPhatSinh(i, 4)
    End If
Next
EndRow = PhatSinh.[A:K].Find(What:="*", LookIn:=xlFormulas, LookAt:=xlPart, SearchOrder:=xlByRows, SearchDirection:=xlPrevious).Row + 1
ArrPhatSinh = PhatSinh.Range("A5:K" & EndRow).Value
ArrTest = PhatSinh.Range("L5:L" & EndRow).Value
For i = 1 To UBound(ArrPhatSinh, 1)
    If ArrPhatSinh(i, 4) Like TaiKhoan & "*" And ArrPhatSinh(i, 7) <> "" Then
        If Not Dic.Exists(ArrPhatSinh(i, 6) & vbBack & ArrPhatSinh(i, 7)) Then
            j = j + 1
            Dic.Add ArrPhatSinh(i, 6) & vbBack & ArrPhatSinh(i, 7), j
        End If
        STT = CLng(Dic.Item(ArrPhatSinh(i, 6) & vbBack & ArrPhatSinh(i, 7)))
        ArrTonKho(STT, 1) = ArrTonKho(STT, 1) + ArrPhatSinh(i, 11)
        ArrTonKho(STT, 2) = ArrTonKho(STT, 2) + ArrPhatSinh(i, 10)
    End If
    If ArrPhatSinh(i, 5) Like TaiKhoan & "*" And ArrPhatSinh(i, 9) <> "" Then
        If Not Dic.Exists(ArrPhatSinh(i, 8) & vbBack & ArrPhatSinh(i, 9)) Then
            ArrTest(i, 1) = 0
        Else
            STT = CLng(Dic.Item(ArrPhatSinh(i, 8) & vbBack & ArrPhatSinh(i, 9)))
            If ArrTonKho(STT, 2) >= ArrPhatSinh(i, 10) Then
                ArrTest(i, 1) = Round(ArrPhatSinh(i, 10) * ArrTonKho(STT, 1) / ArrTonKho(STT, 2), 0)
                ArrTonKho(STT, 1) = ArrTonKho(STT, 1) - ArrTest(i, 1)
                ArrTonKho(STT, 2) = ArrTonKho(STT, 2) - ArrPhatSinh(i, 10)
            ElseIf ArrTonKho(STT, 2) > 0 Then
                ArrTest(i, 1) = ArrTonKho(STT, 1)
                ArrTonKho(STT, 1) = 0
                ArrTonKho(STT, 2) = 0
            ElseIf ArrTonKho(STT, 2) = 0 Then
                ArrTest(i, 1) = 0
            End If
        End If
    End If
Next
PhatSinh.Range("L5:L" & EndRow).Value = ArrTest
Application.Calculation = xlCalculationAutomatic
Application.ScreenUpdating = True
End Sub
Private Sub TinhGiaXK_FIFO()
Application.ScreenUpdating = False
Application.Calculation = xlCalculationManual
Dim ArrPhatSinh, ArrTest, Dic, EndRow As Long, i As Long, TaiKhoan As String, SoLuong As Double, SoLuongTon As Double, SoTien As Double, SoTienTon As Double, Item As String, Gia As String
TaiKhoan = PhatSinh.[E2].Value
Set Dic = CreateObject("Scripting.Dictionary")
ArrPhatSinh = DauKy.Range("A3:E" & DauKy.[A65536].End(xlUp).Row + 1).Value
For i = 1 To UBound(ArrPhatSinh, 1) - 1
    If ArrPhatSinh(i, 1) Like TaiKhoan & "*" Then
        Dic.Add ArrPhatSinh(i, 2) & vbBack & ArrPhatSinh(i, 3), ArrPhatSinh(i, 5) & "/" & ArrPhatSinh(i, 4) & vbBack
    End If
Next
EndRow = PhatSinh.[A:K].Find(What:="*", LookIn:=xlFormulas, LookAt:=xlPart, SearchOrder:=xlByRows, SearchDirection:=xlPrevious).Row + 1
ArrPhatSinh = PhatSinh.Range("A5:K" & EndRow).Value
ArrTest = PhatSinh.Range("L5:L" & EndRow).Value
For i = 1 To UBound(ArrPhatSinh, 1)
    If ArrPhatSinh(i, 4) Like TaiKhoan & "*" And ArrPhatSinh(i, 7) <> "" Then
        If Not Dic.Exists(ArrPhatSinh(i, 6) & vbBack & ArrPhatSinh(i, 7)) Then
            Dic.Add ArrPhatSinh(i, 6) & vbBack & ArrPhatSinh(i, 7), ArrPhatSinh(i, 11) & "/" & ArrPhatSinh(i, 10) & vbBack
        Else
            Dic.Item(ArrPhatSinh(i, 6) & vbBack & ArrPhatSinh(i, 7)) = Dic.Item(ArrPhatSinh(i, 6) & vbBack & ArrPhatSinh(i, 7)) & ArrPhatSinh(i, 11) & "/" & ArrPhatSinh(i, 10) & vbBack
        End If
    End If
    If ArrPhatSinh(i, 5) Like TaiKhoan & "*" And ArrPhatSinh(i, 9) <> "" Then
        If Not Dic.Exists(ArrPhatSinh(i, 8) & vbBack & ArrPhatSinh(i, 9)) Then
            ArrTest(i, 1) = 0
        Else
            Item = Dic.Item(ArrPhatSinh(i, 8) & vbBack & ArrPhatSinh(i, 9))
            SoLuong = ArrPhatSinh(i, 10)
            SoTien = 0
            Do Until SoLuong = 0
                If Item = "" Then
                    Gia = "0/999999999999"
                Else
                    Gia = Left(Item, InStr(Item, vbBack) - 1)
                End If
                SoLuongTon = CDbl(Right(Gia, InStr(StrReverse(Gia), "/") - 1))
                SoTienTon = CDbl(Left(Gia, InStr(Gia, "/") - 1))
                If SoLuong >= SoLuongTon Then
                    SoLuong = SoLuong - SoLuongTon
                    SoTien = SoTien + SoTienTon
                    If Gia <> "0/999999999999" Then Item = Right(Item, Len(Item) - Len(Gia) - 1)
                Else
                    SoTien = SoTien + Round(SoLuong * Evaluate(Gia), 0)
                    If Gia <> "0/999999999999" Then Item = (SoTienTon - Round(SoLuong * Evaluate(Gia), 0)) & "/" & (SoLuongTon - SoLuong) & Right(Item, Len(Item) - Len(Gia))
                    SoLuong = 0
                End If
            Loop
            ArrTest(i, 1) = SoTien
            Dic.Item(ArrPhatSinh(i, 8) & vbBack & ArrPhatSinh(i, 9)) = Item
        End If
    End If
Next
PhatSinh.Range("L5:L" & EndRow).Value = ArrTest
Application.Calculation = xlCalculationAutomatic
Application.ScreenUpdating = True
End Sub
Private Sub TinhGiaXK_LIFO()
Application.ScreenUpdating = False
Application.Calculation = xlCalculationManual
Dim ArrPhatSinh, Dic, EndRow As Long, i As Long, TaiKhoan As String, SoLuong As Double, SoLuongTon As Double, SoTien As Double, SoTienTon As Double, Item As String, Gia As String
TaiKhoan = PhatSinh.[E2].Value
Set Dic = CreateObject("Scripting.Dictionary")
ArrPhatSinh = DauKy.Range("A3:E" & DauKy.[A65536].End(xlUp).Row + 1).Value
For i = 1 To UBound(ArrPhatSinh, 1) - 1
    If ArrPhatSinh(i, 1) Like TaiKhoan & "*" Then
        Dic.Add ArrPhatSinh(i, 2) & vbBack & ArrPhatSinh(i, 3), vbBack & "0/999999999999" & vbBack & ArrPhatSinh(i, 5) & "/" & ArrPhatSinh(i, 4)
    End If
Next
EndRow = PhatSinh.[A:K].Find(What:="*", LookIn:=xlFormulas, LookAt:=xlPart, SearchOrder:=xlByRows, SearchDirection:=xlPrevious).Row + 1
ArrPhatSinh = PhatSinh.Range("A5:K" & EndRow).Value
ArrTest = PhatSinh.Range("L5:L" & EndRow).Value
For i = 1 To UBound(ArrPhatSinh, 1)
    If ArrPhatSinh(i, 4) Like TaiKhoan & "*" And ArrPhatSinh(i, 7) <> "" Then
        If Not Dic.Exists(ArrPhatSinh(i, 6) & vbBack & ArrPhatSinh(i, 7)) Then
            Dic.Add ArrPhatSinh(i, 6) & vbBack & ArrPhatSinh(i, 7), vbBack & "0/999999999999" & vbBack & ArrPhatSinh(i, 11) & "/" & ArrPhatSinh(i, 10)
        Else
            Dic.Item(ArrPhatSinh(i, 6) & vbBack & ArrPhatSinh(i, 7)) = Dic.Item(ArrPhatSinh(i, 6) & vbBack & ArrPhatSinh(i, 7)) & vbBack & ArrPhatSinh(i, 11) & "/" & ArrPhatSinh(i, 10)
        End If
    End If
    If ArrPhatSinh(i, 5) Like TaiKhoan & "*" And ArrPhatSinh(i, 9) <> "" Then
        If Not Dic.Exists(ArrPhatSinh(i, 8) & vbBack & ArrPhatSinh(i, 9)) Then
            ArrTest(i, 1) = 0
        Else
            Item = Dic.Item(ArrPhatSinh(i, 8) & vbBack & ArrPhatSinh(i, 9))
            SoLuong = ArrPhatSinh(i, 10)
            SoTien = 0
            Do Until SoLuong = 0
                Gia = Right(Item, InStr(StrReverse(Item), vbBack) - 1)
                SoLuongTon = CDbl(Right(Gia, InStr(StrReverse(Gia), "/") - 1))
                SoTienTon = CDbl(Left(Gia, InStr(Gia, "/") - 1))
                If SoLuong >= SoLuongTon Then
                    SoLuong = SoLuong - SoLuongTon
                    SoTien = SoTien + SoTienTon
                    Item = Left(Item, Len(Item) - Len(Gia) - 1)
                Else
                    SoTien = SoTien + Round(SoLuong * Evaluate(Gia), 0)
                    Item = Left(Item, Len(Item) - Len(Gia)) & (SoTienTon - Round(SoLuong * Evaluate(Gia), 0)) & "/" & (SoLuongTon - SoLuong)
                    SoLuong = 0
                End If
            Loop
            ArrTest(i, 1) = SoTien
            Dic.Item(ArrPhatSinh(i, 8) & vbBack & ArrPhatSinh(i, 9)) = Item
        End If
    End If
Next
PhatSinh.Range("L5:L" & EndRow).Value = ArrTest
Application.Calculation = xlCalculationAutomatic
Application.ScreenUpdating = True
End Sub
 

File đính kèm

  • TestGiaXuatKho - CHECK.xls
    186 KB · Đọc: 20
Sắp xếp theo thời gian sắp xếp theo bầu chọn
mrbomst đã viết:
Kính gửi mọi người trên diễn đàn.
Em có tham khảo được 1 bài viết của bác #Huuthang trên diễn đàn về mã tính giá xuất kho theo các phương pháp và đã áp dụng được vào bảng tính của mình nhưng chỉ riêng 2 phương pháp là LIFO và FIFO khi chạy dữ liệu lại phát sinh lỗi mà em lại không biết là do đâu. em xin gửi file gốc đã thêm vào dữ liệu để chạy code. mong mọi người có thể sửa lại giúp em ạ!
Em xin cảm ơn mọi người!
Mã: 
Private Sub TinhGiaXK_BQGQThang()
Application.ScreenUpdating = False
Application.Calculation = xlCalculationManual
Dim ArrPhatSinh, ArrTest, ArrTonKho(), ArrViTri(), Dic, EndRow As Long, i As Long, j As Long, k As Long, l As Long, TaiKhoan As String, SoLuong As Double, SoLuongTon As Double, SoTien As Double, SoTienTon As Double, STT As Long, Gia As String
TaiKhoan = PhatSinh.[E2].Value
Set Dic = CreateObject("Scripting.Dictionary")
ArrPhatSinh = DauKy.Range("A3:E" & DauKy.[A65536].End(xlUp).Row + 1).Value
ReDim ArrTonKho(1 To 10000, 1 To 48)
For i = 1 To UBound(ArrPhatSinh, 1) - 1
    If ArrPhatSinh(i, 1) Like TaiKhoan & "*" Then
        j = j + 1
        Dic.Add ArrPhatSinh(i, 2) & vbBack & ArrPhatSinh(i, 3), j
        ArrTonKho(j, 1) = ArrPhatSinh(i, 5)
        ArrTonKho(j, 2) = ArrPhatSinh(i, 4)
    End If
Next
EndRow = PhatSinh.[A:K].Find(What:="*", LookIn:=xlFormulas, LookAt:=xlPart, SearchOrder:=xlByRows, SearchDirection:=xlPrevious).Row + 1
ArrPhatSinh = PhatSinh.Range("A5:K" & EndRow).Value
ArrTest = PhatSinh.Range("L5:L" & EndRow).Value
ReDim ArrViTri(1 To UBound(ArrPhatSinh), 1 To 3)
For i = 1 To UBound(ArrPhatSinh, 1)
    If ArrPhatSinh(i, 4) Like TaiKhoan & "*" And ArrPhatSinh(i, 7) <> "" Then
        If Not Dic.Exists(ArrPhatSinh(i, 6) & vbBack & ArrPhatSinh(i, 7)) Then
            j = j + 1
            Dic.Add ArrPhatSinh(i, 6) & vbBack & ArrPhatSinh(i, 7), j
        End If
        STT = CLng(Dic.Item(ArrPhatSinh(i, 6) & vbBack & ArrPhatSinh(i, 7)))
        ArrTonKho(STT, ArrPhatSinh(i, 1) * 4 - 3) = ArrTonKho(STT, ArrPhatSinh(i, 1) * 4 - 3) + ArrPhatSinh(i, 11)
        ArrTonKho(STT, ArrPhatSinh(i, 1) * 4 - 2) = ArrTonKho(STT, ArrPhatSinh(i, 1) * 4 - 2) + ArrPhatSinh(i, 10)
    End If
    If ArrPhatSinh(i, 5) Like TaiKhoan & "*" And ArrPhatSinh(i, 9) <> "" Then
        If Not Dic.Exists(ArrPhatSinh(i, 8) & vbBack & ArrPhatSinh(i, 9)) Then
            j = j + 1
            Dic.Add ArrPhatSinh(i, 8) & vbBack & ArrPhatSinh(i, 9), j
        End If
        STT = CLng(Dic.Item(ArrPhatSinh(i, 8) & vbBack & ArrPhatSinh(i, 9)))
        ArrTonKho(STT, ArrPhatSinh(i, 1) * 4 - 1) = ArrTonKho(STT, ArrPhatSinh(i, 1) * 4 - 1) + ArrPhatSinh(i, 10)
        k = k + 1
        ArrViTri(k, 1) = ArrPhatSinh(i, 8) & vbBack & ArrPhatSinh(i, 9)
        ArrViTri(k, 2) = ArrPhatSinh(i, 1)
        ArrViTri(k, 3) = i
    End If
Next
For i = 1 To j
    For l = 1 To 12
        If l > 1 Then
            ArrTonKho(i, l * 4 - 3) = ArrTonKho(i, l * 4 - 3) + (ArrTonKho(i, l * 4 - 6) - ArrTonKho(i, l * 4 - 5)) * ArrTonKho(i, l * 4 - 4)
            ArrTonKho(i, l * 4 - 2) = ArrTonKho(i, l * 4 - 2) + ArrTonKho(i, l * 4 - 6) - ArrTonKho(i, l * 4 - 5)
        End If
        If ArrTonKho(i, l * 4 - 2) = 0 Then
            ArrTonKho(i, l * 4) = 0
        Else
            ArrTonKho(i, l * 4) = ArrTonKho(i, l * 4 - 3) / ArrTonKho(i, l * 4 - 2)
        End If
    Next
Next
For i = 1 To k
    STT = CLng(Dic.Item(ArrViTri(i, 1)))
    ArrTest(ArrViTri(i, 3), 1) = Round(ArrTonKho(STT, ArrViTri(i, 2) * 4) * ArrPhatSinh(ArrViTri(i, 3), 10), 0)
Next
PhatSinh.Range("L5:L" & EndRow).Value = ArrTest
Application.Calculation = xlCalculationAutomatic
Application.ScreenUpdating = True
End Sub
Private Sub TinhGiaXK_BQGQNhap()
Application.ScreenUpdating = False
Application.Calculation = xlCalculationManual
Dim ArrPhatSinh, ArrTest, ArrTonKho(), Dic, EndRow As Long, i As Long, j As Long, TaiKhoan As String, SoLuong As Double, SoLuongTon As Double, SoTien As Double, SoTienTon As Double, STT As Long, Gia As String
TaiKhoan = PhatSinh.[E2].Value
Set Dic = CreateObject("Scripting.Dictionary")
ArrPhatSinh = DauKy.Range("A3:E" & DauKy.[A65536].End(xlUp).Row + 1).Value
ReDim ArrTonKho(1 To 10000, 1 To 2)
For i = 1 To UBound(ArrPhatSinh, 1) - 1
    If ArrPhatSinh(i, 1) Like TaiKhoan & "*" Then
        j = j + 1
        Dic.Add ArrPhatSinh(i, 2) & vbBack & ArrPhatSinh(i, 3), j
        ArrTonKho(j, 1) = ArrPhatSinh(i, 5)
        ArrTonKho(j, 2) = ArrPhatSinh(i, 4)
    End If
Next
EndRow = PhatSinh.[A:K].Find(What:="*", LookIn:=xlFormulas, LookAt:=xlPart, SearchOrder:=xlByRows, SearchDirection:=xlPrevious).Row + 1
ArrPhatSinh = PhatSinh.Range("A5:K" & EndRow).Value
ArrTest = PhatSinh.Range("L5:L" & EndRow).Value
For i = 1 To UBound(ArrPhatSinh, 1)
    If ArrPhatSinh(i, 4) Like TaiKhoan & "*" And ArrPhatSinh(i, 7) <> "" Then
        If Not Dic.Exists(ArrPhatSinh(i, 6) & vbBack & ArrPhatSinh(i, 7)) Then
            j = j + 1
            Dic.Add ArrPhatSinh(i, 6) & vbBack & ArrPhatSinh(i, 7), j
        End If
        STT = CLng(Dic.Item(ArrPhatSinh(i, 6) & vbBack & ArrPhatSinh(i, 7)))
        ArrTonKho(STT, 1) = ArrTonKho(STT, 1) + ArrPhatSinh(i, 11)
        ArrTonKho(STT, 2) = ArrTonKho(STT, 2) + ArrPhatSinh(i, 10)
    End If
    If ArrPhatSinh(i, 5) Like TaiKhoan & "*" And ArrPhatSinh(i, 9) <> "" Then
        If Not Dic.Exists(ArrPhatSinh(i, 8) & vbBack & ArrPhatSinh(i, 9)) Then
            ArrTest(i, 1) = 0
        Else
            STT = CLng(Dic.Item(ArrPhatSinh(i, 8) & vbBack & ArrPhatSinh(i, 9)))
            If ArrTonKho(STT, 2) >= ArrPhatSinh(i, 10) Then
                ArrTest(i, 1) = Round(ArrPhatSinh(i, 10) * ArrTonKho(STT, 1) / ArrTonKho(STT, 2), 0)
                ArrTonKho(STT, 1) = ArrTonKho(STT, 1) - ArrTest(i, 1)
                ArrTonKho(STT, 2) = ArrTonKho(STT, 2) - ArrPhatSinh(i, 10)
            ElseIf ArrTonKho(STT, 2) > 0 Then
                ArrTest(i, 1) = ArrTonKho(STT, 1)
                ArrTonKho(STT, 1) = 0
                ArrTonKho(STT, 2) = 0
            ElseIf ArrTonKho(STT, 2) = 0 Then
                ArrTest(i, 1) = 0
            End If
        End If
    End If
Next
PhatSinh.Range("L5:L" & EndRow).Value = ArrTest
Application.Calculation = xlCalculationAutomatic
Application.ScreenUpdating = True
End Sub
Private Sub TinhGiaXK_FIFO()
Application.ScreenUpdating = False
Application.Calculation = xlCalculationManual
Dim ArrPhatSinh, ArrTest, Dic, EndRow As Long, i As Long, TaiKhoan As String, SoLuong As Double, SoLuongTon As Double, SoTien As Double, SoTienTon As Double, Item As String, Gia As String
TaiKhoan = PhatSinh.[E2].Value
Set Dic = CreateObject("Scripting.Dictionary")
ArrPhatSinh = DauKy.Range("A3:E" & DauKy.[A65536].End(xlUp).Row + 1).Value
For i = 1 To UBound(ArrPhatSinh, 1) - 1
    If ArrPhatSinh(i, 1) Like TaiKhoan & "*" Then
        Dic.Add ArrPhatSinh(i, 2) & vbBack & ArrPhatSinh(i, 3), ArrPhatSinh(i, 5) & "/" & ArrPhatSinh(i, 4) & vbBack
    End If
Next
EndRow = PhatSinh.[A:K].Find(What:="*", LookIn:=xlFormulas, LookAt:=xlPart, SearchOrder:=xlByRows, SearchDirection:=xlPrevious).Row + 1
ArrPhatSinh = PhatSinh.Range("A5:K" & EndRow).Value
ArrTest = PhatSinh.Range("L5:L" & EndRow).Value
For i = 1 To UBound(ArrPhatSinh, 1)
    If ArrPhatSinh(i, 4) Like TaiKhoan & "*" And ArrPhatSinh(i, 7) <> "" Then
        If Not Dic.Exists(ArrPhatSinh(i, 6) & vbBack & ArrPhatSinh(i, 7)) Then
            Dic.Add ArrPhatSinh(i, 6) & vbBack & ArrPhatSinh(i, 7), ArrPhatSinh(i, 11) & "/" & ArrPhatSinh(i, 10) & vbBack
        Else
            Dic.Item(ArrPhatSinh(i, 6) & vbBack & ArrPhatSinh(i, 7)) = Dic.Item(ArrPhatSinh(i, 6) & vbBack & ArrPhatSinh(i, 7)) & ArrPhatSinh(i, 11) & "/" & ArrPhatSinh(i, 10) & vbBack
        End If
    End If
    If ArrPhatSinh(i, 5) Like TaiKhoan & "*" And ArrPhatSinh(i, 9) <> "" Then
        If Not Dic.Exists(ArrPhatSinh(i, 8) & vbBack & ArrPhatSinh(i, 9)) Then
            ArrTest(i, 1) = 0
        Else
            Item = Dic.Item(ArrPhatSinh(i, 8) & vbBack & ArrPhatSinh(i, 9))
            SoLuong = ArrPhatSinh(i, 10)
            SoTien = 0
            Do Until SoLuong = 0
                If Item = "" Then
                    Gia = "0/999999999999"
                Else
                    Gia = Left(Item, InStr(Item, vbBack) - 1)
                End If
                SoLuongTon = CDbl(Right(Gia, InStr(StrReverse(Gia), "/") - 1))
                SoTienTon = CDbl(Left(Gia, InStr(Gia, "/") - 1))
                If SoLuong >= SoLuongTon Then
                    SoLuong = SoLuong - SoLuongTon
                    SoTien = SoTien + SoTienTon
                    If Gia <> "0/999999999999" Then Item = Right(Item, Len(Item) - Len(Gia) - 1)
                Else
                    SoTien = SoTien + Round(SoLuong * Evaluate(Gia), 0)
                    If Gia <> "0/999999999999" Then Item = (SoTienTon - Round(SoLuong * Evaluate(Gia), 0)) & "/" & (SoLuongTon - SoLuong) & Right(Item, Len(Item) - Len(Gia))
                    SoLuong = 0
                End If
            Loop
            ArrTest(i, 1) = SoTien
            Dic.Item(ArrPhatSinh(i, 8) & vbBack & ArrPhatSinh(i, 9)) = Item
        End If
    End If
Next
PhatSinh.Range("L5:L" & EndRow).Value = ArrTest
Application.Calculation = xlCalculationAutomatic
Application.ScreenUpdating = True
End Sub
Private Sub TinhGiaXK_LIFO()
Application.ScreenUpdating = False
Application.Calculation = xlCalculationManual
Dim ArrPhatSinh, Dic, EndRow As Long, i As Long, TaiKhoan As String, SoLuong As Double, SoLuongTon As Double, SoTien As Double, SoTienTon As Double, Item As String, Gia As String
TaiKhoan = PhatSinh.[E2].Value
Set Dic = CreateObject("Scripting.Dictionary")
ArrPhatSinh = DauKy.Range("A3:E" & DauKy.[A65536].End(xlUp).Row + 1).Value
For i = 1 To UBound(ArrPhatSinh, 1) - 1
    If ArrPhatSinh(i, 1) Like TaiKhoan & "*" Then
        Dic.Add ArrPhatSinh(i, 2) & vbBack & ArrPhatSinh(i, 3), vbBack & "0/999999999999" & vbBack & ArrPhatSinh(i, 5) & "/" & ArrPhatSinh(i, 4)
    End If
Next
EndRow = PhatSinh.[A:K].Find(What:="*", LookIn:=xlFormulas, LookAt:=xlPart, SearchOrder:=xlByRows, SearchDirection:=xlPrevious).Row + 1
ArrPhatSinh = PhatSinh.Range("A5:K" & EndRow).Value
ArrTest = PhatSinh.Range("L5:L" & EndRow).Value
For i = 1 To UBound(ArrPhatSinh, 1)
    If ArrPhatSinh(i, 4) Like TaiKhoan & "*" And ArrPhatSinh(i, 7) <> "" Then
        If Not Dic.Exists(ArrPhatSinh(i, 6) & vbBack & ArrPhatSinh(i, 7)) Then
            Dic.Add ArrPhatSinh(i, 6) & vbBack & ArrPhatSinh(i, 7), vbBack & "0/999999999999" & vbBack & ArrPhatSinh(i, 11) & "/" & ArrPhatSinh(i, 10)
        Else
            Dic.Item(ArrPhatSinh(i, 6) & vbBack & ArrPhatSinh(i, 7)) = Dic.Item(ArrPhatSinh(i, 6) & vbBack & ArrPhatSinh(i, 7)) & vbBack & ArrPhatSinh(i, 11) & "/" & ArrPhatSinh(i, 10)
        End If
    End If
    If ArrPhatSinh(i, 5) Like TaiKhoan & "*" And ArrPhatSinh(i, 9) <> "" Then
        If Not Dic.Exists(ArrPhatSinh(i, 8) & vbBack & ArrPhatSinh(i, 9)) Then
            ArrTest(i, 1) = 0
        Else
            Item = Dic.Item(ArrPhatSinh(i, 8) & vbBack & ArrPhatSinh(i, 9))
            SoLuong = ArrPhatSinh(i, 10)
            SoTien = 0
            Do Until SoLuong = 0
                Gia = Right(Item, InStr(StrReverse(Item), vbBack) - 1)
                SoLuongTon = CDbl(Right(Gia, InStr(StrReverse(Gia), "/") - 1))
                SoTienTon = CDbl(Left(Gia, InStr(Gia, "/") - 1))
                If SoLuong >= SoLuongTon Then
                    SoLuong = SoLuong - SoLuongTon
                    SoTien = SoTien + SoTienTon
                    Item = Left(Item, Len(Item) - Len(Gia) - 1)
                Else
                    SoTien = SoTien + Round(SoLuong * Evaluate(Gia), 0)
                    Item = Left(Item, Len(Item) - Len(Gia)) & (SoTienTon - Round(SoLuong * Evaluate(Gia), 0)) & "/" & (SoLuongTon - SoLuong)
                    SoLuong = 0
                End If
            Loop
            ArrTest(i, 1) = SoTien
            Dic.Item(ArrPhatSinh(i, 8) & vbBack & ArrPhatSinh(i, 9)) = Item
        End If
    End If
Next
PhatSinh.Range("L5:L" & EndRow).Value = ArrTest
Application.Calculation = xlCalculationAutomatic
Application.ScreenUpdating = True
End Sub
Nhấp chuột vào đây để mở rộng...
Lỗi ở đoạn nào dòng nào vậy?
Hay kết quả sai thế nào?
 
Upvote 0
Upvote 0
Maika8008 đã viết:
Kiểu này chắc InStr không tìm ra cái ký tự "/" nên đối số thứ hai của hàm Right bị nhận giá trị ÂM 1 rồi. Còn vì sao tìm không ra thì chưa biết
Nhấp chuột vào đây để mở rộng...
Em có thử và để ý thấy thì khi có phát sinh nhiều hơn 12 mã hàng xuất liền nhau thì xảy ra lỗi như vậy. nếu <= 12 mã hàng xuất liền nhau thì không xảy ra lỗi.1610174302122.png
 
Upvote 0
mrbomst đã viết:
Em có thử và để ý thấy thì khi có phát sinh nhiều hơn 12 mã hàng xuất liền nhau thì xảy ra lỗi như vậy. nếu <= 12 mã hàng xuất liền nhau thì không xảy ra lỗi.View attachment 252720
Nhấp chuột vào đây để mở rộng...
Không phải do chỗ đó đâu. Tôi đã dò khi chạy code và thấy có 1 item không bình thường, nó chỉ chứa dấu / và ký tự vbBack. Đó là nguyên nhân gây lỗi cho các dòng code chạy sau đó. Giờ tôi bận, nếu khi quay lại mà chưa có ai giúp bạn thì tôi tiếp tục.
 
Upvote 0
mrbomst đã viết:
Em có thử và để ý thấy thì khi có phát sinh nhiều hơn 12 mã hàng xuất liền nhau thì xảy ra lỗi như vậy. nếu <= 12 mã hàng xuất liền nhau thì không xảy ra lỗi.
Nhấp chuột vào đây để mở rộng...

Maika8008 đã viết:
Không phải do chỗ đó đâu. Tôi đã dò khi chạy code và thấy có 1 item không bình thường, nó chỉ chứa dấu / và ký tự vbBack. Đó là nguyên nhân gây lỗi cho các dòng code chạy sau đó. Giờ tôi bận, nếu khi quay lại mà chưa có ai giúp bạn thì tôi tiếp tục.
Nhấp chuột vào đây để mở rộng...
Em cũng đã chạy code và cũng thấy có 1 lỗi đấy. hy vọng bác sẽ sửa giúp em ạ.
1610177319864.png
 
Upvote 0
Tính cho tài khoản nào thì tài khoản đó phải có đủ thông tin.
Tính cho tài khoản bắt đầu là 15 là bao gồm tài khoản 154, muốn vậy thì nếu nghiệp vụ có TK nợ là 154 thì cột Mã hàng nhập phải có dữ liệu tương ứng.

Với file bài #1, tính cho TK 152 thì nhập 152 vào E2 và xem lại những chỗ như hình dưới và điền dữ liệu cho hợp lệ.

1610178065162.png
 
Upvote 0
huuthang_bd đã viết:
Tính cho tài khoản nào thì tài khoản đó phải có đủ thông tin.
Tính cho tài khoản bắt đầu là 15 là bao gồm tài khoản 154, muốn vậy thì nếu nghiệp vụ có TK nợ là 154 thì cột Mã hàng nhập phải có dữ liệu tương ứng.

Với file bài #1, tính cho TK 152 thì nhập 152 vào E2 và xem lại những chỗ như hình dưới và điền dữ liệu cho hợp lệ.

View attachment 252725
Nhấp chuột vào đây để mở rộng...
Em cảm ơn bác đã quan tâm và trả lời hướng dẫn em ạ.
Em đã ra soát lại dữ liệu và điều lại vào ô E2 là 152 nhưng vẫn bị phát sinh lỗi. chỉ khi điền đúng tài khoản muốn tính là 15211 thì công thức đã chạy đúng. nhưng trong file của bác thì em thấy bác chỉ để tài khoản là 15 và có phát sinh cả những tài khoản 156, 153 152 chứ không chỉ riêng gì tài khoản 152. không biết là do đâu ạ. vì nếu để tại E2 là 15211 thì khi có tài khoản mới nó lại không tính ạ.
 

File đính kèm

  • DULIEUSUA.xls
    180.5 KB · Đọc: 9
Upvote 0
Làm sao đừng để xuất âm kho là hết lỗi. Ngoài ra, dữ liệu tồn đầu kỳ phải đồng bộ với phát sinh trong kỳ.
Nói chung dữ liệu phải chuẩn thì mới tính đến chuyện khác.
 
Upvote 0
huuthang_bd đã viết:
Làm sao đừng để xuất âm kho là hết lỗi. Ngoài ra, dữ liệu tồn đầu kỳ phải đồng bộ với phát sinh trong kỳ.
Nói chung dữ liệu phải chuẩn thì mới tính đến chuyện khác.
Nhấp chuột vào đây để mở rộng...
Em cảm ơn bác ạ. Sau một hồi thử hết tất cả các trường hợp lỗi thì hoá ra chỉ cần thêm dữ liệu tồn đầu kỳ bằng 0 thay vì để trống là hết ạ!
 
Lần chỉnh sửa cuối:
Upvote 0
mrbomst đã viết:
TH2: Dữ liệu tồn đầu kỳ =0 và dữ liệu nhập >0 thì lỗi
TH3: Dự liệu tồn đầu kỳ > 0 và dữ liệu nhập = 0, đồng dữ liệu xuất > tồn đầu kỳ thì lỗi
Nhấp chuột vào đây để mở rộng...
Xuất âm kho không lỗi nhưng kết quả không đúng, code trả về tổng giá trị tồn kho ngay trước thời điểm xuất.
Bằng 0 và ô trống là khác nhau. Do để ô trống nên mới có lỗi, bằng 0 không lỗi. Đương nhiên ô trống và ô có giá trị bằng 0 phải coi như nhau (bằng 0) nhưng lúc viết code tôi không nghĩ đến trường hợp dữ liệu tồn kho đầu kỳ lại có ô trống.
 
Upvote 0
huuthang_bd đã viết:
Xuất âm kho không lỗi nhưng kết quả không đúng, code trả về tổng giá trị tồn kho ngay trước thời điểm xuất.
Bằng 0 và ô trống là khác nhau. Do để ô trống nên mới có lỗi, bằng 0 không lỗi. Đương nhiên ô trống và ô có giá trị bằng 0 phải coi như nhau (bằng 0) nhưng lúc viết code tôi không nghĩ đến trường hợp dữ liệu tồn kho đầu kỳ lại có ô trống.
Nhấp chuột vào đây để mở rộng...
Em chuyển ô trống bằng giá trị 0 đã hết lỗi rồi ạ. em cảm ơn bác. một lỗi đơn giản mà em tìm bao ngày nay mới ra ạ. em xin cảm ơn bác về hướng dẫn và code mà bác đã chia sẻ ạ!
 
Upvote 0
Em mong mọi người có thế giúp em sửa lại mã này của tác giả với trường hợp khi tách riêng dữ liệu phát sinh cho Nhập và xuất ra 2 sheet khac nhau. khi em thay mảng dữ liệu bằng 2 mảng nhập và mảng xuấtthì hàm chạy giá xuất kho BQGQ tháng, LIFO và FIFO bị sai. theo em nghĩ là mã này không phân biệt được ngày phát sinh mà nó hiểu theo thứ tự xuất hiện dữ liệu trên excel, khi dùng 2 mảng thì sẽ tính dữ liệu nhập trước rồi đến dữ liệu xuất cho nên khi tính giá nó lệch với hàm đầu mà ở đấy dữ liệu đã được sắp xếp theo ngày. (cũng giống như trường hợp để 1 sheet dữ liệu nhưng dữ liệu nhập phát sinh trước và dữ liệu xuất phát sinh sau.) có thể em trình bày hơi dài dòng nhưng hy vọng có người hiểu được và sửa lại giúp em mã ạ! Em xin cảm ơn ạ!
 

File đính kèm

  • TestGiaXuatKho - CHECK.xls
    416 KB · Đọc: 7
Upvote 0
Bạn phải đăng nhập hoặc đăng ký để trả lời bài viết tại đây.
Web KT

Bài viết mới nhất

huynhnhu1234
Tìm giá vé máy bay một chiều và khứ hồi
Trả lời
0
Đọc
10
huynhnhu1234
huynhnhu1234
B
Lọc dữ liệu trùng, đếm số lần, tự tô màu theo điều kiện.
Trả lời
1
Đọc
44
tranvansau278
T
P
Tổng hợp dữ liệu từ các sheet theo chọn lọc
Trả lời
11
Đọc
188
VetMini
V
V
[Nhờ giúp đỡ] Cách tìm thời gian bị trùng trong excel ở nhiều thời gian khác nhau
Trả lời
7
Đọc
107
tranvansau278
T
kimtanmap
  • Question
Nhờ viết code VBA Macro lập lại.
Trả lời
4
Đọc
95
Hoàng Tuấn 868
H
N
Hàm tìm giá trị theo giờ vào - ra
Trả lời
6
Đọc
98
Nguyễn Linh hn94
N
zarra
Cần giúp tạo form in mã vạch cho vật tư theo SL cụ thể.
Trả lời
4
Đọc
142
zarra
zarra
C
Chia sẻ: Kết quả xổ số Keno
    • Thích
Trả lời
2
Đọc
113
CHAOQUAY
C
Nguyễn Duy Tuân
  • Question
Chia sẻ ControlForOffice - Bộ công cụ điều khiển Office/Excel
    • Thích
6 7 8
Trả lời
148
Đọc
95K
leminhksvl
L
HeSanbi
  • Question
Lỗi VBA: Cài đặt thông số ForceVBALoadFromSource trong Registry để VBA biên dịch không bị lỗi
    • Cảm ơn
    • Thích
Trả lời
5
Đọc
286
anhdepjai
A
Tuấn Bụng Bự
  • Question
Tìm Bộ 8 số xuất hiện nhiều nhất trong random( 1 - 80)
Trả lời
16
Đọc
343
CHAOQUAY
C
H
Hàm đếm số ngày thứ bảy và chủ nhật trong một khoảng thời gian
Trả lời
18
Đọc
19K
DeTong
D
ongke0711
  • Question
Tải hóa đơn điện tử (https://hoadondientu.gdt.gov.vn/) Excel Vba
    • Thích
    • Yêu thích
11 12 13
Trả lời
245
Đọc
13K
Hoàng Trọng Hữu
Hoàng Trọng Hữu
D
  • Question
Xin cách sắp xếp dữ liệu theo thứ tự không làm hỏng link
Trả lời
7
Đọc
294
cantl
C
N
Giúp sửa mã code
Trả lời
16
Đọc
265
ptm0412
ptm0412
dung09031989
Xin giúp công thức tô màu các ô phía sau khi kế hoạch đặt hàng thiếu so với tồn kho.?
Trả lời
0
Đọc
51
dung09031989
dung09031989
C
Công thức tự nhập liệu số lượng nhập khi bị âm
Trả lời
0
Đọc
53
cherry0187
C
N
Vẽ biểu đồ kết hợp nhiều yếu tố trong excel
Trả lời
1
Đọc
50
hoangminhtien
hoangminhtien
GPE-Trợ Lý
KHÓA HỌC BỨT PHÁ KỸ NĂNG EXCEL
    • Thích
Trả lời
0
Đọc
182
GPE-Trợ Lý
GPE-Trợ Lý
dunghtgiga
  • Đã khóa
Tính bốn tuần cho một tháng
Trả lời
9
Đọc
293
ptm0412
ptm0412
Xem thêm…

Thành viên có số lượng bài viết cao nhất tháng

Thành viên có điểm tương tác cao nhất tháng

Back
Top Bottom