Tính giá vốn bằng VBA (Dictionary) (1 người xem)

Liên hệ QC

Người dùng đang xem chủ đề này

dream3616

Thành viên chính thức
Tham gia
28/8/08
Bài viết
81
Được thích
46
Em có tham khảo một số bài viết trên GPE nhưng chưa tìm được giải pháp phù hợp để tính giá vốn cho file của mình. Em gửi kèm file. Bài toán này không biết dùng Dic có giải quyết được không Nhờ mọi người giúp đỡ. Trân trọng cảm ơn
 

File đính kèm

Công thức tính giá vốn:
Mã:
=IF(H10=0,0,((SUMIF(Ma!$A$7:$A$19,NX!C10,Ma!$D$7:$D$19)+SUMIF($C$9:C9,C10,$G$9:G9)-SUMIF($C$9:C9,C10,$J$9:J9))/(SUMIF(Ma!$A$7:$A$19,NX!C10,Ma!$C$7:$C$19)+SUMIF($C$9:C9,C10,$F$9:F9)-SUMIF($C$9:C9,C10,$H$9:H9))))
Số lượng tồn cuối kỳ:
Mã:
=SUMIF(Ma!$A$7:$A$19,NX!C10,Ma!$C$7:$C$19)+SUMIF($C$10:C10,C10,$F$10:F10)-SUMIF($C$10:C10,C10,$H$10:H10)
Tồn TT cuối kỳ:
Mã:
=SUMIF(Ma!$A$7:$A$19,NX!C10,Ma!$D$7:$D$19)+SUMIF($C$10:C10,C10,$G$10:G10)-SUMIF($C$10:C10,C10,$J$10:J10)
Em gửi lại file đính kèm với công thức đang làm bằng e xcel. Nhờ anh chị và các bạn giúp đỡ chuyển công thức sau bằng VBA
 

File đính kèm

Upvote 0
Ở bài 2, mình đã minh họa bằng công thức và diễn giải lại. Mình nghĩ có thể dùng sumif tính được, chắc cũng có thể chuyển nó bằng VBA nhưng hiện tại chưa nghĩ ra được. Hơn nữa ko phải ai cũng học chuyên ngành kế toán nên ko phải hiểu ngay được vấn đề. Số lương hiện tại gần 40.000 dòng nên chạy hơi lâu. Có vấn đề gì không hiểu về cách tính, các bạn cứ phản hồi mình sẽ giải thích và diễn giải lại. Trân trọng cảm ơn.
 
Upvote 0
KHông biết có bạn nào có hướng làm theo yêu cầu của bài 2 không ah.
 
Upvote 0
Mã:
Public Sub Gia_Von()
Dim Dic As Object, sArr(), dArr(), I As Long, J As Long, K As Long, Tem As String, N
Set Dic = CreateObject("Scripting.Dictionary")
With Sheets("Ma")
    sArr = .Range(.[A7], .[A7].End(xlDown)).Resize(, 4).Value
End With
ReDim dArr(1 To UBound(sArr, 1), 1 To 9)
For I = 1 To UBound(sArr, 1)
    Tem = sArr(I, 1)
    If Not Dic.Exists(Tem) Then
        K = K + 1
        Dic.Add Tem, K
        dArr(K, 1) = sArr(I, 3) ' So luong ton dau ky
        dArr(K, 2) = sArr(I, 4) ' Thanh tien ton dau ky
        
    End If
Next I
With Sheets("NX")
    sArr = .Range(.[A9], .[A9].End(xlDown)).Resize(, 15).Value
End With
For I = 1 To UBound(sArr, 1)
    Tem = sArr(I, 3)
    If Dic.Exists(Tem) Then
        N = Dic.Item(Tem)
            dArr(N, 1) = dArr(N, 1) + sArr(I, 5) - sArr(I, 7) ' Tong so luong cong don
            dArr(N, 2) = dArr(N, 2) + sArr(I, 6) - sArr(I, 9) ' Tong thanh tien cong don
            dArr(N, 3) = dArr(N, 2) + sArr(I, 6) - sArr(I, 9) / dArr(N, 1) + sArr(I, 5) - sArr(I, 7) ' Gia von
      
    End If
Next I
Set Dic = Nothing
End Sub
Đây là ý tưởng của em, nhưng chưa biết thể hiện làm sao cho đúng
 
Upvote 0
Đây là ý tưởng của em, nhưng chưa biết thể hiện làm sao cho đúng

Mình không hiểu về KT nhưng làm thấy kết quả giông giống nhau nên gửi cho bạn tham khảo
PHP:
Sub update()
Dim d As Object, d2 As Object
Dim hangton
Dim i, j
Set d = CreateObject("scripting.dictionary")
Set d2 = CreateObject("scripting.dictionary")
hangton = Sheet2.Range("A7:D" & Sheet2.Range("D" & Sheet2.Rows.Count).End(3).Row)
Application.ScreenUpdating = False
        For i = 1 To UBound(hangton)
            If Not d.exists(hangton(i, 1)) Then
                d.Add hangton(i, 1), hangton(i, 3)
                d2.Add hangton(i, 1), hangton(i, 4)
            End If
        Next
     With Sheet1
        .Range("I10:L200").ClearContents
        For j = 10 To 200
                If .Cells(j, 3) <> "" Then
                   If d.exists(.Cells(j, 3).Value) Then
                     If .Cells(j, 6) <> "" Then
                          d.Item(.Cells(j, 3).Value) = d.Item(.Cells(j, 3).Value) + .Cells(j, 6).Value
                          d2.Item(.Cells(j, 3).Value) = d2.Item(.Cells(j, 3).Value) + .Cells(j, 7).Value
                          .Cells(j, 11) = d.Item(.Cells(j, 3).Value)
                          .Cells(j, 12) = d2.Item(.Cells(j, 3).Value)
                         Else
                          .Cells(j, 9) = d2.Item(.Cells(j, 3).Value) / d.Item(.Cells(j, 3).Value)
                          .Cells(j, 10) = .Cells(j, 8) * .Cells(j, 9)
                           d.Item(.Cells(j, 3).Value) = d.Item(.Cells(j, 3).Value) - .Cells(j, 8).Value
                          d2.Item(.Cells(j, 3).Value) = d2.Item(.Cells(j, 3).Value) - .Cells(j, 10).Value
                          .Cells(j, 11) = d.Item(.Cells(j, 3).Value)
                          .Cells(j, 12) = d2.Item(.Cells(j, 3).Value)
                          
                     End If
                   End If
                End If
         Next
     End With
 Application.ScreenUpdating = True
End Sub
 
Upvote 0
Mình không hiểu về KT nhưng làm thấy kết quả giông giống nhau nên gửi cho bạn tham khảo
PHP:
Sub update()
Dim d As Object, d2 As Object
Dim hangton
Dim i, j
Set d = CreateObject("scripting.dictionary")
Set d2 = CreateObject("scripting.dictionary")
hangton = Sheet2.Range("A7:D" & Sheet2.Range("D" & Sheet2.Rows.Count).End(3).Row)
Application.ScreenUpdating = False
        For i = 1 To UBound(hangton)
            If Not d.exists(hangton(i, 1)) Then
                d.Add hangton(i, 1), hangton(i, 3)
                d2.Add hangton(i, 1), hangton(i, 4)
            End If
        Next
     With Sheet1
        .Range("I10:L200").ClearContents
        For j = 10 To 200
                If .Cells(j, 3) <> "" Then
                   If d.exists(.Cells(j, 3).Value) Then
                     If .Cells(j, 6) <> "" Then
                          d.Item(.Cells(j, 3).Value) = d.Item(.Cells(j, 3).Value) + .Cells(j, 6).Value
                          d2.Item(.Cells(j, 3).Value) = d2.Item(.Cells(j, 3).Value) + .Cells(j, 7).Value
                          .Cells(j, 11) = d.Item(.Cells(j, 3).Value)
                          .Cells(j, 12) = d2.Item(.Cells(j, 3).Value)
                         Else
                          .Cells(j, 9) = d2.Item(.Cells(j, 3).Value) / d.Item(.Cells(j, 3).Value)
                          .Cells(j, 10) = .Cells(j, 8) * .Cells(j, 9)
                           d.Item(.Cells(j, 3).Value) = d.Item(.Cells(j, 3).Value) - .Cells(j, 8).Value
                          d2.Item(.Cells(j, 3).Value) = d2.Item(.Cells(j, 3).Value) - .Cells(j, 10).Value
                          .Cells(j, 11) = d.Item(.Cells(j, 3).Value)
                          .Cells(j, 12) = d2.Item(.Cells(j, 3).Value)
                          
                     End If
                   End If
                End If
         Next
     End With
 Application.ScreenUpdating = True
End Sub

Trước hết, cảm ơn bạn nhiều nhé bài viết và phản hồi đầu tiên.
Mình sẽ test thử
 
Upvote 0

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

Back
Top Bottom