[已解决]用VBA指定取数

xhuang

HI，各位

      请帮忙按附件要求，用VBA指定取数！

book.zip (475.75 KB, 下载次数: 16)

2014-2-21 16:08 上传

点击文件名下载附件

最佳答案

月排行榜 / 总排行榜

dsmch

2014-2-21 21:46

………………

跳转到最佳答案楼层

dsmch

1. Sub Macro1()
   
2. On Error Resume Next
   
3. Dim arr, brr, crr, drr, d, i&, j%, k%
   
4. Set d = CreateObject("scripting.dictionary")
   
5. arr = Sheets("数据").Range("a4").CurrentRegion
   
6. brr = Sheets("指定工序").Range("a4").CurrentRegion
   
7. crr = Sheets("取数").Range("a4").CurrentRegion
   
8. ReDim drr(1 To UBound(arr), 1 To UBound(crr, 2))
   
9. MsgBox UBound(drr, 2)
   
10. For j = 1 To UBound(arr, 2)
    
11.     d(arr(1, j)) = j
    
12. Next
    
13. For i = 2 To UBound(arr)
    
14.     d(arr(i, 2)) = d(arr(i, 2)) & " " & i
    
15. Next
    
16. For i = 2 To UBound(brr)
    
17.     x = Split(d(brr(i, 1)))
    
18.     For j = 1 To UBound(x)
    
19.         s = s + 1
    
20.         For k = 1 To UBound(crr, 2)
    
21.             drr(s, k) = arr(Val(x(j)), d(crr(1, k)))
    
22.         Next
    
23.     Next
    
24. Next
    
25. Sheets("取数").Range("a5").Resize(s, UBound(drr, 2)) = drr
    
26. End Sub
    

复制代码

dsmch

………………