[已解决]数组问题求助

WLMAAB

到货单中的到货量来满足"分配单"中各客户的需求量,不能足的有多少满多少,并显示在本次分配量中.

最佳答案

月排行榜 / 总排行榜

grf1973

2015-1-26 11:27

代码简化一点

1. Sub 分配()
   
2.     arr = Sheet2.[a1].CurrentRegion
   
3.     Set d = CreateObject("scripting.dictionary")
   
4.     For i = 2 To UBound(arr)
   
5.         d(arr(i, 1)) = arr(i, 2)
   
6.     Next
   
7.    
   
8.     brr = [a1].CurrentRegion
   
9.     For i = 2 To UBound(brr)
   
10.         x = brr(i, 1): xq = brr(i, 3)
    
11.         brr(i, 4) = Application.Min(d(x), brr(i, 3))  '本次分配，按到货量和需求量中的小值
    
12.         d(x) = d(x) - brr(i, 4)          '分配后，到货量减之
    
13.         brr(i, 5) = brr(i, 3) - brr(i, 4)
    
14.     Next
    
15.     [a1].CurrentRegion = brr
    
16. End Sub

复制代码

跳转到最佳答案楼层

grf1973

1. Sub 分配()
   
2.     arr = Sheet2.[a1].CurrentRegion
   
3.     Set d = CreateObject("scripting.dictionary")
   
4.     For i = 2 To UBound(arr)
   
5.         d(arr(i, 1)) = arr(i, 2)
   
6.     Next
   
7.    
   
8.     brr = [a1].CurrentRegion
   
9.     For i = 2 To UBound(brr)
   
10.         x = brr(i, 1): xq = brr(i, 3)
    
11.         If d(x) > 0 Then
    
12.             If xq <= d(x) Then '需求<=到货量，本次分配需求量
    
13.                 brr(i, 4) = xq: d(x) = d(x) - xq
    
14.             Else          '需求>到货量，本次分配到货量
    
15.                 brr(i, 4) = d(x): d(x) = 0
    
16.             End If
    
17.         End If
    
18.         brr(i, 5) = brr(i, 3) - brr(i, 4)
    
19.     Next
    
20.     [a1].CurrentRegion = brr
    
21. End Sub
    

复制代码

grf1973

请看附件。

grf1973

代码简化一点

1. Sub 分配()
   
2.     arr = Sheet2.[a1].CurrentRegion
   
3.     Set d = CreateObject("scripting.dictionary")
   
4.     For i = 2 To UBound(arr)
   
5.         d(arr(i, 1)) = arr(i, 2)
   
6.     Next
   
7.    
   
8.     brr = [a1].CurrentRegion
   
9.     For i = 2 To UBound(brr)
   
10.         x = brr(i, 1): xq = brr(i, 3)
    
11.         brr(i, 4) = Application.Min(d(x), brr(i, 3))  '本次分配，按到货量和需求量中的小值
    
12.         d(x) = d(x) - brr(i, 4)          '分配后，到货量减之
    
13.         brr(i, 5) = brr(i, 3) - brr(i, 4)
    
14.     Next
    
15.     [a1].CurrentRegion = brr
    
16. End Sub

复制代码

baksy

F2公式，下拉；
=IF(VLOOKUP(A2,到货!A:B,2,)-SUMPRODUCT((A$2:A2=A2)*($C$2:C2))<0,0,C2)

WLMAAB

谢谢！各位相助！已经实现了需求