订单需求与库存分配问题

Elvis.lj

根据订单需求的明细，结合现有库存分配拣货任务，当订单需求中存在重复SKU时，现有分配逻辑不会考虑每次分配后的库存变化，导致重复的SKU都去分配同一个货位的拣货任务，导致库存不足

请教各位大神该如何解决，感谢

Elvis.lj

还望大佬帮忙看看

鄂龙蒙

1. Sub 仓库分配()
   
2.     Dim arr, brr, crr()
   
3.     Dim m, n, i, j, x, y, a, b, k, t
   
4.     Dim d As Object
   
5.     Set d = CreateObject("scripting.dictionary")
   
6.     arr = Sheet1.Range("J3:M6")
   
7.     For i = 1 To UBound(arr)
   
8.          If Not d.exists(arr(i, 3)) Then
   
9.             m = 1
   
10.             ReDim brr(1 To 3, 1 To m)
    
11.         Else
    
12.             brr = d(arr(i, 3))
    
13.             m = UBound(brr, 2) + 1
    
14.             ReDim Preserve brr(1 To 3, 1 To m)
    
15.         End If
    
16.         For j = 1 To 2
    
17.             brr(j, m) = arr(i, j)
    
18.         Next
    
19.         brr(3, m) = arr(i, 4)
    
20.         d(arr(i, 3)) = brr
    
21.     Next
    
22.     k = d.keys
    
23.     t = d.items
    
24.     arr = Sheet1.Range("A3:D6")
    
25.     For i = 1 To UBound(arr)
    
26.         b = arr(i, 3)
    
27.         For x = 0 To d.Count - 1
    
28.             If arr(i, 2) = k(x) Then
    
29.                 For j = 1 To UBound(t(x), 2)
    
30.                     a = 0
    
31.                     a = t(x)(3, j)
    
32.                     If a > 0 Then
    
33.                         If a >= b Then
    
34.                             t(x)(3, j) = t(x)(3, j) - b
    
35.                             n = n + 1
    
36.                             ReDim Preserve crr(1 To 6, 1 To n)
    
37.                             crr(1, n) = arr(i, 4)
    
38.                             crr(2, n) = arr(i, 1)
    
39.                             crr(3, n) = arr(i, 3)
    
40.                             crr(4, n) = t(x)(1, j)
    
41.                             crr(5, n) = t(x)(3, j)
    
42.                             crr(6, n) = b
    
43.                             For y = 1 To n - 1
    
44.                                 If crr(4, y) = crr(4, n) Then
    
45.                                     crr(5, y) = 0
    
46.                                     Exit For
    
47.                                 End If
    
48.                             Next
    
49.                             b = b - a
    
50.                             GoTo line1
    
51.                         ElseIf a < b Then
    
52.                             t(x)(3, j) = 0
    
53.                             n = n + 1
    
54.                             ReDim Preserve crr(1 To 6, 1 To n)
    
55.                             crr(1, n) = arr(i, 4)
    
56.                             crr(2, n) = arr(i, 1)
    
57.                             crr(3, n) = arr(i, 3)
    
58.                             crr(4, n) = t(x)(1, j)
    
59.                             crr(5, n) = t(x)(3, j)
    
60.                             crr(6, n) = a
    
61.                             For y = 1 To n - 1
    
62.                                 If crr(4, y) = crr(4, n) Then
    
63.                                     crr(5, y) = 0
    
64.                                     Exit For
    
65.                                 End If
    
66.                             Next
    
67.                             b = b - a
    
68.                             If b = 0 Then GoTo line1
    
69.                         End If
    
70.                     End If
    
71.                 Next
    
72.             End If
    
73.         Next
    
74. line1:
    
75.     Next
    
76.     Sheet1.Range("J11:O20") = ""
    
77.     If n > 0 Then Sheet1.[J11].Resize(n, 6) = Application.Transpose(crr)
    
78.     Set d = Nothing
    
79. End Sub

复制代码

鄂龙蒙

库存分配.rar (31.82 KB, 下载次数: 11)

2021-8-14 20:42 上传

点击文件名下载附件

旧巷123

鄂龙蒙 发表于 2021-8-14 20:42

大神，这个能不能用函数嵌套出来啊

鄂龙蒙

旧巷123 发表于 2021-8-15 15:30
大神，这个能不能用函数嵌套出来啊

用函数不会做呀

旧巷123

鄂龙蒙 发表于 2021-8-15 15:38
用函数不会做呀

这个是vba嘛

Elvis.lj

鄂龙蒙 发表于 2021-8-14 20:42

感谢感谢，不知是否有方法通过Power Query实现

旧巷123

这个怎么样才能发帖啊

zpy2

旧巷123 发表于 2021-8-21 09:09
这个怎么样才能发帖啊

点开 一个板块 比如 vba ,,有个 按钮 就是 发帖