多品种先进先出法的计算

肖喜思

请大神、高手、老师们帮忙，什么方法或公式可以做到G列的成本按照采购表里面的时间先后顺序进行核算，先入库的先摊，摊完前面这个批次的才能再去摊后面那个批次的，有多个产品需要去匹配，商品编号是不变的，H列是我手动计算出来的结果，可以去进行比对

鄂龙蒙

楼主31行计算结果：87.5  有误，用程序计算应该是：52.3  吧

鄂龙蒙

0.1*83+0.5*88=52.3

肖喜思

鄂龙蒙 发表于 2019-12-29 13:45
0.1*83+0.5*88=52.3

是的是的，不好意思

Yalishanda30

附件供参考，小数不好处理。。。

Yalishanda30

Yalishanda30 发表于 2019-12-29 14:32
附件供参考，小数不好处理。。。

更新，增加小数处理，最小单位0.1.。。。

chxw68

1. Sub test()
   
2.   Dim r%, i%
   
3.   Dim arr, brr
   
4.   Dim d As Object
   
5.   Application.ScreenUpdating = False
   
6.   Application.DisplayAlerts = False
   
7.   Set d = CreateObject("scripting.dictionary")
   
8.   With Worksheets("12月采购")
   
9.     r = .Cells(.Rows.Count, 1).End(xlUp).Row
   
10.     arr = .Range("a2:h" & r)
    
11.     For i = 1 To UBound(arr)
    
12.       If Not d.exists(arr(i, 1)) Then
    
13.         m = 1
    
14.         ReDim brr(1 To 2, 1 To m)
    
15.       Else
    
16.         brr = d(arr(i, 1))
    
17.         m = UBound(brr, 2) + 1
    
18.         ReDim Preserve brr(1 To 2, 1 To m)
    
19.       End If
    
20.       brr(1, m) = arr(i, 4)
    
21.       brr(2, m) = arr(i, 5)
    
22.       d(arr(i, 1)) = brr
    
23.     Next
    
24.   End With
    
25.   With Worksheets("12月销售")
    
26.     r = .Cells(.Rows.Count, 1).End(xlUp).Row
    
27.     arr = .Range("a2:s" & r)
    
28.     ReDim crr(1 To UBound(arr), 1 To 1)
    
29.     For i = 1 To UBound(arr)
    
30.       sl = arr(i, 3)
    
31.       cb = 0
    
32.       If d.exists(arr(i, 1)) Then
    
33.         brr = d(arr(i, 1))
    
34.         For k = 1 To UBound(brr, 2)
    
35.           If brr(1, k) > 0 Then
    
36.             If brr(1, k) >= sl Then
    
37.               cb = cb + sl * brr(2, k)
    
38.               brr(1, k) = brr(1, k) - sl
    
39.               sl = 0
    
40.             ElseIf brr(1, k) < sl Then
    
41.               cb = cb + brr(1, k) * brr(2, k)
    
42.               brr(1, k) = 0
    
43.               sl = sl - brr(1, k)
    
44.             End If
    
45.             d(arr(i, 1)) = brr
    
46.           End If
    
47.           If sl = 0 Then
    
48.             Exit For
    
49.           End If
    
50.         Next
    
51.       End If
    
52.       crr(i, 1) = cb
    
53.     Next
    
54.     .Range("g2").Resize(UBound(crr), 1) = crr
    
55.   End With
    
56. End Sub
    

复制代码

chxw68

详见附件。

肖喜思

Yalishanda30 发表于 2019-12-29 15:26
更新，增加小数处理，最小单位0.1.。。。

谢谢老师，小花花先送上，我刚刚测试了一下，其他的地方都没有问题，就是上一个批次和下一个批次转换的过程中计算会有稍微的一点点差异，就是比如第一批是83元，第二批是88元，第一批还剩下1件未摊，然后刚好这一条销售数据是卖了2件，那么此时的平均成本的算法是（83*1+88*1）/2=85.5元，就这个地方有点差异

肖喜思

chxw68 发表于 2019-12-29 15:26

谢谢老师回答我的问题，小花先送上，我刚刚试了一下，就是上一个批次和下一个批次转换的过程当中，如果有小数点的存在就会出现计算上的偏差，比如上一个批次还剩下最后0.4件，然后当期销售了1件，那么就是83*0.4+（1-0.4）*88=86