Gửi tặng file tính giá xuất kho theo các phương pháp

Liên hệ QC
huuthang_bd

huuthang_bd

Chuyên gia GPE
Tham gia
10/9/08
Bài viết
8,709
Được thích
10,814
Donate (Momo)
Donate
Giới tính
Nam
Nghề nghiệp
Thợ đụng
Để phục vụ cho công việc, mình có tạo một file dùng để tính giá xuất kho theo các phương pháp. Xin chia sẻ cùng các bạn.
File này có thể tính được giá xuất kho theo các phương pháp: Bình quân gia quyền tháng, bình quân gia quyền liên kế, FIFO và LIFO.
 

File đính kèm

  • TestGiaXuatKho.rar
    61 KB · Đọc: 2,444
Hi bạn! Sao mình mở ra không có công thức gì vậy?
 
file đã khoá hết công thức trong VBA rồi, chẳng học hỏi đc điều gì bạn ơi
 
bạn cho mật khẩu VBA để mọi người hoc hỏi với
Cám ơn nhiều!
 
Chẳng giải quyết được vấn đề gì
 
minh mới tham gia diễn đàn, hướng dẫn giúp mình cách đặt câu hỏi lên diễn đàn nhắn tin qua email cho mình muoimuoikt.79@gmail.com
 
Bạn huuthang_bd

cho bài mà bạn khóa hết công thức rùi thì bọn mình cũng chẳng hiểu.
 
tính chết đêm theo công thức ah sao khóa không cho ai học thế chia sẻ làm gì
+-+-+-++-+-+-++-+-+-++-+-+-++-+-+-++-+-+-++-+-+-++-+-+-++-+-+-++-+-+-++-+-+-++-+-+-+
 
huuthang_bd đã viết:
Để phục vụ cho công việc, mình có tạo một file dùng để tính giá xuất kho theo các phương pháp. Xin chia sẻ cùng các bạn.
File này có thể tính được giá xuất kho theo các phương pháp: Bình quân gia quyền tháng, bình quân gia quyền liên kế, FIFO và LIFO.
Nhấp chuột vào đây để mở rộng...

A/C ơi, nhờ A/c cho em pass code vba này với, e muốn học hỏi chứ không có ý gì hết
Cám ơn A/C nhiều
 
locphat6868 đã viết:
A/C ơi, nhờ A/c cho em pass code vba này với, e muốn học hỏi chứ không có ý gì hết
Cám ơn A/C nhiều
Nhấp chuột vào đây để mở rộng...

Code trong file đây, bạn tham khảo:
Mã: 
Private Sub XoaDuLieu()
Dim EndRow As Long
EndRow = PhatSinh.[A:L].Find(What:="*", LookIn:=xlFormulas, LookAt:=xlPart, SearchOrder:=xlByRows, SearchDirection:=xlPrevious).Row
PhatSinh.Range("A5:L" & EndRow).ClearContents
End Sub
Private Sub TinhGiaXK()
Dim EndRow As Long
EndRow = PhatSinh.[A:K].Find(What:="*", LookIn:=xlFormulas, LookAt:=xlPart, SearchOrder:=xlByRows, SearchDirection:=xlPrevious).Row
PhatSinh.Range("A5:A65536").ClearContents
PhatSinh.Range("L5:L65536").ClearContents
If EndRow = 4 Then Exit Sub
With PhatSinh.Range("A5:A" & EndRow)
    .FormulaR1C1 = "=MONTH(RC[1])"
    .Value = .Value
End With
Select Case PhatSinh.[G2].Value
Case "BQGQ tháng"
    TinhGiaXK_BQGQThang
Case "BQGQ sau m" & ChrW(7895) & "i l" & ChrW(7847) & "n nh" & ChrW(7853) & "p"
    TinhGiaXK_BQGQNhap
Case "FIFO"
    TinhGiaXK_FIFO
Case "LIFO"
    TinhGiaXK_LIFO
End Select
End Sub
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ờ A/C code giúp e với
VBA xuất từ excel sang pdf với điều kiện như sau:
Đặt tên file xuất sang pdf theo tên thay đổi theo giá trị tại ô G10 (G10 là giá trị nằm trong danh sách)
vd: Nếu ô G10 là A thì xuất đặt tên file pdf là A.pdf
Nếu ô G10 là B thì xuất đặt tên file pdf là B.pdf
Nếu ô G10 là C thì xuất đặt tên file pdf là C.pdf

Chân thành cám ơn
 
Mấy anh chị xem giúp file này, phương pháp "Bình quân gia quyền tháng" lại cho kết quả theo phương pháp FIFO, còn chọn cách xuất theo FIFO thì kết quả ra không đúng.
 
enemyvn đã viết:
Mấy anh chị xem giúp file này, phương pháp "Bình quân gia quyền tháng" lại cho kết quả theo phương pháp FIFO, còn chọn cách xuất theo FIFO thì kết quả ra không đúng.
Nhấp chuột vào đây để mở rộng...
Bạn thử đưa file dữ liệu mà bạn cho là code tính không đúng và kết quả đúng theo bạn lên xem sao.
Nói khơi khơi vậy ai biết đâu mà lần.
 
Sorry em quên, em up file lên anh xem hộ với. Cảm ơn a đã chia sẻ, thực sự file rất hữu ích. A xem giúp em nhé
 

File đính kèm

  • TestGiaXuatKho-aXEMLAI DUM.xls
    133 KB · Đọc: 125
enemyvn đã viết:
Sorry em quên, em up file lên anh xem hộ với. Cảm ơn a đã chia sẻ, thực sự file rất hữu ích. A xem giúp em nhé
Nhấp chuột vào đây để mở rộng...
Không có gì sai cả. Mã hàng có phân biệt chữ hoa, chữ thường. Nếu khác nhau thì code sẽ xem là 2 mã khác nhau. Trong file của bạn, code xem 1561Tcuc và 1561TCuc là 2 mã khác nhau.
 
Gửi file lên mà còn cố dấu chi không biết trong khi bạn cũng học hỏi từ nhiều người trên này.
 
khanh3 đã viết:
Gửi file lên mà còn cố dấu chi không biết trong khi bạn cũng học hỏi từ nhiều người trên này.
Nhấp chuột vào đây để mở rộng...
Vẫn còn hơn nhiều người tham gia bao nhiêu năm mà chả cống hiến gì cả đấy bạn. Chỉ toàn vào xem có gì hay thì mang về làm của riêng thôi.
 
Anh có thể sửa đoạn code để có thể tính giá xuất kho theo các phương pháp và tính theo từng kho được không ạ
 
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

H
  • Question
nhờ các bác viết mẫu cho em lệnh dùng checkbox để rút ngắn thời gian thao tác
Trả lời
15
Đọc
319
hiv174
H
kiencuong030184
  • Question
Nhờ giúp đỡ về ẩn dòng, cột có điều kiện
Trả lời
1
Đọc
34
BuiQuangThuan
B
T
V/v tối ưu xử lý đoạn code
Trả lời
1
Đọc
45
SA_DQ
SA_DQ
kiet317
Helloooooooooooo
    • Phẫn nộ
    • Buồn
Trả lời
1
Đọc
34
Hoàng Tuấn 868
H
H
  • Question
Code subtotal và tìm điều kiện
Trả lời
9
Đọc
109
Hoàng Tuấn 868
H
Xem thêm…

Facebook

Giaiphapexcel.com

Group

DIỄN ĐÀN GIẢI PHÁP EXCEL Group 1
DIỄN ĐÀN GIẢI PHÁP EXCEL Group 2

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