循环匹配宏求助

chenyulo

懂一点VBA皮毛，但也只限皮毛。。。求助下大大

表1是基础稿，需要依靠表2进行分配，匹配字段都是A列。比如表1第一行是10000，那就按照表2先进先出，需要选取表2的三列数据，拆分成三条，分别是500，9000，500（合计一万），然后将对应的单价分别填到对于的数量里面，以此类推求助谁能帮忙下，最终结果如表sheet"拆分结果示范"

liulang0808

1. Sub 按钮1_Click()
   
2.     arr = Sheets("表1").UsedRange
   
3.     brr = Sheets("表2").UsedRange
   
4.     Application.ScreenUpdating = False
   
5.     Sheets(3).Select
   
6.     ActiveSheet.UsedRange.Offset(1).ClearContents
   
7.     For j = 2 To UBound(brr)
   
8.         If Len(brr(j, 13)) > 0 Then brr(j, 14) = brr(j, 12) / brr(j, 13)
   
9.     Next j
   
10.     For j = 2 To UBound(arr)
    
11.         m = arr(j, 10)
    
12.         For i = 2 To UBound(brr)
    
13.             If brr(i, 13) <> 0 Then
    
14.                 If m <= brr(i, 13) Then
    
15.                     brr(i, 13) = brr(i, 13) - m
    
16.                     r = Cells(Rows.Count, 1).End(3).Row + 1
    
17.                     For x = 1 To UBound(arr, 2) - 2
    
18.                         Cells(r, x) = arr(j, x)
    
19.                     Next x
    
20.                     Cells(r, 10) = m
    
21.                     Cells(r, 11) = brr(i, 14)
    
22.                     Exit For
    
23.                 Else
    
24.                     
    
25.                     r = Cells(Rows.Count, 1).End(3).Row + 1
    
26.                     For x = 1 To UBound(arr, 2) - 2
    
27.                         Cells(r, x) = arr(j, x)
    
28.                     Next x
    
29.                     Cells(r, 10) = brr(i, 13)
    
30.                     Cells(r, 11) = brr(i, 14)
    
31.                     m = m - brr(i, 13)
    
32.                     brr(i, 13) = 0
    
33.                 End If
    
34.             End If
    
35.         Next i
    
36.     Next j
    
37.     Application.ScreenUpdating = True
    
38. End Sub
    

复制代码

liulang0808

附件内容供参考。。。。。。

chenyulo

感谢大大，我试试结果

chenyulo

liulang0808 发表于 2019-10-9 07:50
附件内容供参考。。。。。。

大大，表有点问题，比如物料如果不是25017，那应该是匹配不出东西，但是宏依然会出现数据，没有按照A列的公司+物料一一对应。另外表1可能有几百行，表2数据源有一万行左右，测试了下，会出现错误，发现这两点问题求助，谢谢！！

liulang0808

附件内容增加了一个判断。。。。

chenyulo

liulang0808 发表于 2019-10-9 20:58
附件内容增加了一个判断。。。。

大大，提示溢出，是数据太多了吗？

liulang0808

代码调整了，参考下吧

chenyulo

liulang0808 发表于 2019-10-10 12:48
代码调整了，参考下吧

谢谢大大，基本能实现需求，送你小花花