[已解决]如何从一个表中提取所有物料到另一个表中

beijiquan

从"看板卡清单"中提取所有"判定=1"的看板的物料，生成一个新的看板bom清单， 比如看板卡清单中新文件号为BC01-0010的看板的记录是这样的： 序号 电线物料号 长度 二区端子物料号 二区防水栓物料号 一区端子物料号 一区防水栓物料号 新文件号 判定 1 M19902228 1060 M22002346 M30600090 BC01-0010 1 要求生成的bom清单为： 新文件号 物料描述 物料号 使用数量 四班数量 四班单位 BC01-0010 电线 M19902228 1060（线长） 1.06（线长/1000） MT BC01-0010 端子 M22002346 1 0.001 KP BC01-0010 防水栓 M30600090 1 0.001 KP 哪位高手可以帮个忙，写一个VBA代码，本人刚刚接触VBA，还是一头雾水。

最佳答案

月排行榜 / 总排行榜

grf1973

2015-4-30 16:06

1. Sub tt()
   
2.     arr = Range("a1:i" & Range("a65536").End(3).Row)
   
3.     ReDim brr(1 To 4 * UBound(arr), 1 To 6)
   
4.     Dim a(1 To 7)
   
5.     a(2) = "电线":
   
6.     a(4) = "端子": a(6) = "端子"
   
7.     a(5) = "防水栓": a(7) = "防水栓"
   
8.     For i = 2 To UBound(arr)
   
9.         For j = 2 To 7
   
10.             If arr(i, 9) = 1 And a(j) <> "" And arr(i, j) <> "" Then
    
11.                 n = n + 1
    
12.                 brr(n, 1) = arr(i, 8)
    
13.                 brr(n, 2) = a(j)
    
14.                 brr(n, 3) = arr(i, j)
    
15.                 brr(n, 4) = IIf(j = 2, arr(i, 3), 1)
    
16.                 brr(n, 5) = brr(n, 4) / 1000
    
17.                 brr(n, 6) = IIf(j = 2, "MT", "KP")
    
18.             End If
    
19.         Next
    
20.     Next
    
21.     Sheet2.[H2].Resize(n, 6) = brr
    
22. End Sub
    

复制代码

跳转到最佳答案楼层

beijiquan

怎么没人回复啊

grf1973

1. Sub tt()
   
2.     arr = Range("a1:i" & Range("a65536").End(3).Row)
   
3.     ReDim brr(1 To 4 * UBound(arr), 1 To 6)
   
4.     Dim a(1 To 7)
   
5.     a(2) = "电线":
   
6.     a(4) = "端子": a(6) = "端子"
   
7.     a(5) = "防水栓": a(7) = "防水栓"
   
8.     For i = 2 To UBound(arr)
   
9.         For j = 2 To 7
   
10.             If arr(i, 9) = 1 And a(j) <> "" And arr(i, j) <> "" Then
    
11.                 n = n + 1
    
12.                 brr(n, 1) = arr(i, 8)
    
13.                 brr(n, 2) = a(j)
    
14.                 brr(n, 3) = arr(i, j)
    
15.                 brr(n, 4) = IIf(j = 2, arr(i, 3), 1)
    
16.                 brr(n, 5) = brr(n, 4) / 1000
    
17.                 brr(n, 6) = IIf(j = 2, "MT", "KP")
    
18.             End If
    
19.         Next
    
20.     Next
    
21.     Sheet2.[H2].Resize(n, 6) = brr
    
22. End Sub
    

复制代码

grf1973

数据放在H列开始，方便比较。
你的模拟结果中二区的端子、防水栓没放进去。

beijiquan

如果物料内容为空，就不用放到bom清单中，谢谢，我先研究一下你的答案