[已解决]在VBA中如何用对数据进行查询，并对查询到的数据进行处理？

beijiquan

零件号	电线物料号	备注	长度_(mm)	M No.1端子物料号	M No.1 防水栓物料号	M No.2端子物料号	M No.2防水栓物料号	新看板号（D）	不同看板号
C9CS-73600	M19900822		545	(C1)M22001487		M22001441	M30600086	PC-D-01-00100	PC-D-01-00100
C9CS-73600	M19900806		1235	(C1)M22001487		M22001459		PC-D-01-00100	PC-D-01-00200
A1350	M19901103		376	M22001706		(D)M22001527		PC-D-01-00200	PC-D-01-00300
A1350	M19901092		690	M22001424		(D)M22001527		PC-D-01-00200	PC-D-01-00400
C9CS-73600	M19900801		550	M22001486		(D)M22001441	PP0440722	PC-D-01-00300	PC-D-01-00500
C9CS-73606	M19900601		670	M22001359		(D)M22001441	PP0440721	PC-D-01-00400	PC-D-01-00600
C9CS-73606	M19900740		670	M22001359		(D)M22001441	PP0440721	PC-D-01-00500	PC-D-01-00700

要求在从零件号到新看板号这个区域中，根据历遍不同看板号中的内容选择新看板号=不同看板号的数据，比如不同看板号为“PC-D-01-00100”,根据该内容应查询到两条记录，如下：

零件号	电线物料号	备注	长度_(mm)	M No.1端子物料号	M No.1 防水栓物料号	M No.2端子物料号	M No.2防水栓物料号	新看板号（D）	不同看板号
C9CS-73600	M19900822		545	(C1)M22001487		M22001441	M30600086	PC-D-01-00100	PC-D-01-00100
C9CS-73600	M19900806		1235	(C1)M22001487		M22001459		PC-D-01-00100

再根据这两条记录，来提取所有的物料号。提取的物料号应该如下所示：

看板号	物料描述	物料号	使用数量	四班数量	四班单位
PC-D-01-00100	电线	M19900822	545	0.545	MT
PC-D-01-00100	端子	M22001487	1	0.001	KP
PC-D-01-00100	端子	M22001441	1	0.001	KP
PC-D-01-00100	防水栓	M30600086	1	0.001	KP
PC-D-01-00100	电线	M19900806	1235	1.235	MT
PC-D-01-00100	端子	M22001459	1	0.001	KP

因为这两条记录中“M No.1端子物料号”的内容相同，故应只提取一次M No.1端子物料号。请高手帮忙实现该功能，或给出实现该功能的办法，谢谢

最佳答案

月排行榜 / 总排行榜

grf1973

2015-5-25 16:37

1. Sub tt()
   
2.     kb = Range("k2:k" & [k65536].End(3).Row)
   
3.     Set d = CreateObject("scripting.dictionary")
   
4.     arr = Range("a2:j" & [b65536].End(3).Row)
   
5.     ReDim brr(1 To 5 * UBound(arr), 1 To 6)
   
6.     crr = Array("电线", "端子", "防水栓", "端子", "防水栓")
   
7.     drr = Array(3, 6, 7, 8, 9)
   
8.     For i = 1 To UBound(kb)
   
9.         kbh = kb(i, 1)
   
10.         For k = 1 To UBound(arr)
    
11.             If arr(k, 10) = kbh Then
    
12.                 For j = 0 To 4
    
13.                     c = drr(j): x = crr(j): wlh = arr(k, c)
    
14.                     If wlh <> "" And Not d.exists(kbh & wlh) Then
    
15.                         n = n + 1
    
16.                         d(kbh & wlh) = ""
    
17.                         brr(n, 1) = kbh
    
18.                         brr(n, 2) = x
    
19.                         brr(n, 3) = wlh
    
20.                         If InStr(wlh, ")") > 0 Then brr(n, 3) = Split(wlh, ")")(1)
    
21.                         If j = 0 Then
    
22.                             brr(n, 4) = arr(k, c + 2)
    
23.                             brr(n, 6) = "MT"
    
24.                         Else
    
25.                             brr(n, 4) = 1
    
26.                             brr(n, 6) = "RP"
    
27.                         End If
    
28.                         brr(n, 5) = brr(n, 4) / 1000
    
29.                     End If
    
30.                 Next
    
31.             End If
    
32.         Next
    
33.     Next
    
34.     If n > 0 Then [m10].Resize(n, 6) = brr
    
35. End Sub
    

复制代码

跳转到最佳答案楼层

grf1973

1. Sub tt()
   
2.     kb = Range("k2:k" & [k65536].End(3).Row)
   
3.     Set d = CreateObject("scripting.dictionary")
   
4.     arr = Range("a2:j" & [b65536].End(3).Row)
   
5.     ReDim brr(1 To 5 * UBound(arr), 1 To 6)
   
6.     crr = Array("电线", "端子", "防水栓", "端子", "防水栓")
   
7.     drr = Array(3, 6, 7, 8, 9)
   
8.     For i = 1 To UBound(kb)
   
9.         kbh = kb(i, 1)
   
10.         For k = 1 To UBound(arr)
    
11.             If arr(k, 10) = kbh Then
    
12.                 For j = 0 To 4
    
13.                     c = drr(j): x = crr(j): wlh = arr(k, c)
    
14.                     If wlh <> "" And Not d.exists(kbh & wlh) Then
    
15.                         n = n + 1
    
16.                         d(kbh & wlh) = ""
    
17.                         brr(n, 1) = kbh
    
18.                         brr(n, 2) = x
    
19.                         brr(n, 3) = wlh
    
20.                         If InStr(wlh, ")") > 0 Then brr(n, 3) = Split(wlh, ")")(1)
    
21.                         If j = 0 Then
    
22.                             brr(n, 4) = arr(k, c + 2)
    
23.                             brr(n, 6) = "MT"
    
24.                         Else
    
25.                             brr(n, 4) = 1
    
26.                             brr(n, 6) = "RP"
    
27.                         End If
    
28.                         brr(n, 5) = brr(n, 4) / 1000
    
29.                     End If
    
30.                 Next
    
31.             End If
    
32.         Next
    
33.     Next
    
34.     If n > 0 Then [m10].Resize(n, 6) = brr
    
35. End Sub
    

复制代码