关于库存数量的分析

zhao__feng

各位老师，请帮忙看下关于库存数量的分析刚如何处理，使用先进先出，推算现有库存是由哪些单据组成的，谢谢。 Book1.rar (1.97 KB, 下载次数: 6)

2018-9-22 16:45 上传

点击文件名下载附件

zhao__feng

谢谢各位，！

鄂龙蒙

1. Sub 先进先出计算结存()
   
2.     Dim m, n, x, i, j, arr, brr, ar, br(), a, b, c, ai, s
   
3.     Dim d As Object, k, t
   
4.     Set d = CreateObject("scripting.dictionary")
   
5.     ar = Range("A1").CurrentRegion
   
6.     arr = Range("D2:G" & [D65536].End(3).Row)
   
7.     [W1].Resize(UBound(arr), 4) = arr
   
8.     Range("W1:Z" & UBound(arr) + 1).Sort Key1:=Range("X1"), Key2:=Range("W1")
   
9.     arr = Range("W1").CurrentRegion
   
10.     Range("P1:Z10000") = "": s = Range("I2:N2")
    
11.     For i = 1 To UBound(arr)
    
12.         If Not d.exists(arr(i, 2)) Then
    
13.             m = 1: ReDim brr(1 To 4, 1 To m)
    
14.         Else
    
15.             brr = d(arr(i, 2))
    
16.             m = UBound(brr, 2) + 1: ReDim Preserve brr(1 To 4, 1 To m)
    
17.         End If
    
18.         For j = 1 To 4: brr(j, m) = arr(i, j): Next
    
19.         d(arr(i, 2)) = brr
    
20.     Next
    
21.     k = d.keys: t = d.items
    
22.     For x = 0 To d.Count - 1
    
23.         n = n + 1: ReDim Preserve br(1 To 6, 1 To n)
    
24.         br(1, n) = k(x)
    
25.         b = 0
    
26.         For i = 2 To UBound(ar)
    
27.             If ar(i, 1) = k(x) Then br(2, n) = ar(i, 2): b = ar(i, 2)
    
28.         Next
    
29.         a = 0
    
30.         For i = UBound(t(x), 2) To 1 Step -1
    
31.             a = a + t(x)(4, i)
    
32.             If a >= b Then ai = i: Exit For
    
33.         Next
    
34.         If a = b Then
    
35.             For i = UBound(t(x), 2) To ai Step -1
    
36.                 For j = 1 To 4: br(j + 2, n) = t(x)(j, i): Next
    
37.                 n = n + 1: ReDim Preserve br(1 To 6, 1 To n)
    
38.             Next
    
39.         Else
    
40.             c = 0
    
41.             For i = UBound(t(x), 2) To ai + 1 Step -1
    
42.                 For j = 1 To 4: br(j + 2, n) = t(x)(j, i): Next
    
43.                 c = c + t(x)(4, i)
    
44.                 n = n + 1: ReDim Preserve br(1 To 6, 1 To n)
    
45.             Next
    
46.             For j = 1 To 4: br(j + 2, n) = t(x)(j, ai): Next
    
47.             If c + t(x)(4, i) < b Then
    
48.                  n = n + 1: ReDim Preserve br(1 To 6, 1 To n)
    
49.                 br(3, n) = "以前年度": br(4, n) = k(x): br(6, n) = b - c - t(x)(4, i)
    
50.             Else
    
51.                 br(6, n) = b - c
    
52.             End If
    
53.         End If
    
54.     Next
    
55.     [p2].Resize(1, 6) = s: [p3].Resize(n, 6) = Application.Transpose(br)
    
56.     Set d = Nothing
    
57. End Sub

复制代码

鄂龙蒙

zhao__feng

万分感谢！

zhao__feng

老师，我在a5增加一个D，程序出错了，请在看看，谢谢

zhao__feng

请老师看看