[已解决]求助，根据多个仓库分配应退数量

哈啊哈

应退数量是已知需要退回的数量，
想把表格C列应退的数量，随机分配到对应每个仓的数量（库存足够足的情况下）。

在8大仓都有现货的情况下，可以随机选择退哪个仓的数量（无规则），请大神们帮助写vba代码呀。感谢感谢

最佳答案

月排行榜 / 总排行榜

林木水123

2023-9-6 18:42

1. Sub demo林()
   
2.     Dim arr, brr, crr, h, n, sht1, sht2, i, j, a, b
   
3.     Set sht1 = Worksheets("导出文本")
   
4.     Set sht2 = Worksheets("操作2")
   
5.     With sht1
   
6.             h = .Range("A65535").End(xlUp).Row
   
7.             n = .Range("a1").End(xlToRight).Column
   
8.             arr = .Range("A1:C" & h)
   
9.             brr = .Range("D1").Resize(1, n - 3)
   
10.     End With
    
11.     With sht2
    
12.         .UsedRange.ClearContents
    
13.         .Range("A1").Resize(h, 3) = arr
    
14.         For i = 1 To n - 3
    
15.             .Range("D1:D" & h).Offset(0, j * 2) = sht1.Range("D1:D" & h).Offset(0, j).Value
    
16.             .Range("D1:D" & h).Offset(0, j * 2 + 1) = ""
    
17.             .Range("D1").Offset(0, j * 2 + 1) = VBA.Replace(sht1.Range("D1").Offset(0, j).Value, "现货库存", "下架数量")
    
18.             j = j + 1
    
19.         Next
    
20.         .Range("D1").Offset(0, j * 2).Resize(1, 3) = Array("总退货", "总剩余", "核对")
    
21. 
    
22.     For i = 2 To h
    
23.         If arr(i, 3) = 0 Or arr(i, 3) = "" Then
    
24.         Else
    
25.             a = 0
    
26.             For j = 4 To 2 * (n - 3) + 3
    
27.                     If arr(i, 3) = .Range("D1").Offset(i - 1, j - 4).Value Then
    
28.                         a = 1
    
29.                         .Range("D1").Offset(i - 1, j - 4 + 1) = arr(i, 3)
    
30.                         Exit For
    
31.                     End If
    
32.             Next j
    
33.             If a = 0 Then
    
34.                 For j = 4 To 2 * (n - 3) + 3
    
35.                     b = Application.WorksheetFunction.Min(VBA.Val(arr(i, 3)), VBA.Val(.Range("D1").Offset(i - 1, j - 4).Value))
    
36.                     .Range("D1").Offset(i - 1, j - 4 + 1) = b
    
37.                     j = j + 1
    
38.                     arr(i, 3) = arr(i, 3) - b
    
39.                     If arr(i, 3) = 0 Then
    
40.                         Exit For
    
41.                     End If
    
42.                 Next j
    
43.             End If
    
44.         End If
    
45.     Next
    
46.    End With
    
47. End Sub
    
48. 
    

复制代码

跳转到最佳答案楼层

林木水123

1. Sub demo林()
   
2.     Dim arr, brr, crr, h, n, sht1, sht2, i, j, a, b
   
3.     Set sht1 = Worksheets("导出文本")
   
4.     Set sht2 = Worksheets("操作2")
   
5.     With sht1
   
6.             h = .Range("A65535").End(xlUp).Row
   
7.             n = .Range("a1").End(xlToRight).Column
   
8.             arr = .Range("A1:C" & h)
   
9.             brr = .Range("D1").Resize(1, n - 3)
   
10.     End With
    
11.     With sht2
    
12.         .UsedRange.ClearContents
    
13.         .Range("A1").Resize(h, 3) = arr
    
14.         For i = 1 To n - 3
    
15.             .Range("D1:D" & h).Offset(0, j * 2) = sht1.Range("D1:D" & h).Offset(0, j).Value
    
16.             .Range("D1:D" & h).Offset(0, j * 2 + 1) = ""
    
17.             .Range("D1").Offset(0, j * 2 + 1) = VBA.Replace(sht1.Range("D1").Offset(0, j).Value, "现货库存", "下架数量")
    
18.             j = j + 1
    
19.         Next
    
20.         .Range("D1").Offset(0, j * 2).Resize(1, 3) = Array("总退货", "总剩余", "核对")
    
21. 
    
22.     For i = 2 To h
    
23.         If arr(i, 3) = 0 Or arr(i, 3) = "" Then
    
24.         Else
    
25.             a = 0
    
26.             For j = 4 To 2 * (n - 3) + 3
    
27.                     If arr(i, 3) = .Range("D1").Offset(i - 1, j - 4).Value Then
    
28.                         a = 1
    
29.                         .Range("D1").Offset(i - 1, j - 4 + 1) = arr(i, 3)
    
30.                         Exit For
    
31.                     End If
    
32.             Next j
    
33.             If a = 0 Then
    
34.                 For j = 4 To 2 * (n - 3) + 3
    
35.                     b = Application.WorksheetFunction.Min(VBA.Val(arr(i, 3)), VBA.Val(.Range("D1").Offset(i - 1, j - 4).Value))
    
36.                     .Range("D1").Offset(i - 1, j - 4 + 1) = b
    
37.                     j = j + 1
    
38.                     arr(i, 3) = arr(i, 3) - b
    
39.                     If arr(i, 3) = 0 Then
    
40.                         Exit For
    
41.                     End If
    
42.                 Next j
    
43.             End If
    
44.         End If
    
45.     Next
    
46.    End With
    
47. End Sub
    
48. 
    

复制代码

哈啊哈

林木水123 发表于 2023-9-6 18:42

谢谢老师，非常感谢

林木水123

哈啊哈 发表于 2023-9-7 21:56
谢谢老师，非常感谢

不用客气