多品种先进先出法的计算

Yalishanda30

肖喜思 发表于 2019-12-29 16:08
谢谢老师，小花花先送上，我刚刚测试了一下，其他的地方都没有问题，就是上一个批次和下一个批次转换的过 ...

需要更新判断。。。

chxw68

就是有点小BUG，修改好了。

chxw68

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

没见你的代码，你是怎么计算出来这项是错误的？点赞！

肖喜思

chxw68 发表于 2019-12-29 16:38
就是有点小BUG，修改好了。

万分感谢，今天用一整个月的数据试了一下，非常好

TY雨

chxw68 发表于 2019-12-29 16:39
没见你的代码，你是怎么计算出来这项是错误的？点赞！

向大佬膜拜。真的好厉害啊。我看了好久才看懂，高手就是高手。

不吃饭可以

chxw68 发表于 2019-12-29 16:38
就是有点小BUG，修改好了。

这个文件 打开了 说VBA或者什么被删了 没办法运行 这个要怎么办

chxw68

不吃饭可以 发表于 2023-4-14 21:30
这个文件 打开了 说VBA或者什么被删了 没办法运行 这个要怎么办

我打开没问题。

不吃饭可以

chxw68 发表于 2023-4-14 21:32
我打开没问题。

那我想看 运行不了怎么办 :'(
我的excel之前有运行过VBA 设置上应该没有问题:

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. '      If i = 30 Then
    
31. '        Stop
    
32. '      End If
    
33.       sl = arr(i, 3)
    
34.       cb = 0
    
35.       If d.exists(arr(i, 1)) Then
    
36.         brr = d(arr(i, 1))
    
37.         For k = 1 To UBound(brr, 2)
    
38.           If brr(1, k) > 0 Then
    
39.             If brr(1, k) >= sl Then
    
40.               cb = cb + sl * brr(2, k)
    
41.               brr(1, k) = brr(1, k) - sl
    
42.               sl = 0
    
43.             ElseIf brr(1, k) < sl Then
    
44.               cb = cb + brr(1, k) * brr(2, k)
    
45.               sl = sl - brr(1, k)
    
46.               brr(1, k) = 0
    
47.             End If
    
48.             d(arr(i, 1)) = brr
    
49.           End If
    
50.           If sl = 0 Then
    
51.             Exit For
    
52.           End If
    
53.         Next
    
54.       End If
    
55.       crr(i, 1) = cb
    
56.     Next
    
57.     .Range("g2").Resize(UBound(crr), 1) = crr
    
58.   End With
    
59. End Sub
    

复制代码

chxw68

不吃饭可以 发表于 2023-4-17 19:56
那我想看 运行不了怎么办 :'(
我的excel之前有运行过VBA 设置上应该没有问题:

把代码贴上来了，正在审核。