求助大神，如何筛选合并

tianyatai

大神们，给看看如何从表1中筛选出与表3中相同名称的，并将表一中对应的值填写到表3中

chxw68

1. Sub test()
   
2.   Dim r%, i%
   
3.   Dim arr, brr
   
4.   Dim d As Object
   
5.   Set d = CreateObject("scripting.dictionary")
   
6.   With Worksheets("sheet3")
   
7.     r = .Cells(.Rows.Count, 1).End(xlUp).Row
   
8.     arr = .Range("a2:m" & r)
   
9.     For i = 1 To UBound(arr)
   
10.       d(CStr(arr(i, 2))) = i
    
11.     Next
    
12.   End With
    
13.   With Worksheets("sheet1")
    
14.     r = .Cells(.Rows.Count, 1).End(xlUp).Row
    
15.     brr = .Range("a2:f" & r)
    
16.     For i = 1 To UBound(brr)
    
17.       If d.exists(CStr(brr(i, 4))) Then
    
18.         m = d(CStr(brr(i, 4)))
    
19.         arr(m, 11) = brr(i, 6)
    
20.       End If
    
21.     Next
    
22.   End With
    
23.   With Worksheets("sheet3")
    
24.     .Columns(2).NumberFormatLocal = "@"
    
25.     .Range("a2").Resize(UBound(arr), UBound(arr, 2)) = arr
    
26.   End With
    
27. End Sub
    
28. 
    

复制代码

chxw68

详见附件。

tianyatai

谢谢大神 啊！还有个问题想请教，那我如何从表2中将A、C、F列提取出来并将A列中相同物料代码的进行合并显示在表4中呢

tianyatai

chxw68 发表于 2018-3-29 08:27
详见附件。

谢谢大神 啊！还有个问题想请教，那我如何从表2中将A、C、F列提取出来并按A列中相同物料代码的进行合并，F列求和 显示在表4中呢

chxw68

tianyatai 发表于 2018-3-29 08:39
谢谢大神 啊！还有个问题想请教，那我如何从表2中将A、C、F列提取出来并按A列中相同物料代码的进行合并， ...

哪个是表2？哪个是表4？还是以Sheet标签名来称呼吧。

tianyatai

chxw68 发表于 2018-3-29 08:52
哪个是表2？哪个是表4？还是以Sheet标签名来称呼吧。

，那我如何从sheet2中将A、C、F列提取出来并将A列中相同物料代码的进行合并显示在sheet4中呢

chxw68

1. Sub test4()
   
2.   Dim r%, i%
   
3.   Dim arr, brr
   
4.   Dim d As Object
   
5.   Set d = CreateObject("scripting.dictionary")
   
6.   With Worksheets("sheet2")
   
7.     r = .Cells(.Rows.Count, 1).End(xlUp).Row
   
8.     arr = .Range("a2:f" & r)
   
9.     For i = 1 To UBound(arr)
   
10.       If Not d.exists(arr(i, 1)) Then
    
11.         ReDim brr(1 To 3)
    
12.         brr(1) = arr(i, 1)
    
13.         brr(2) = arr(i, 3)
    
14.       Else
    
15.         brr = d(arr(i, 1))
    
16.       End If
    
17.       brr(3) = brr(3) + arr(i, 6)
    
18.       d(arr(i, 1)) = brr
    
19.     Next
    
20.   End With
    
21.   With Worksheets("sheet4")
    
22.     .UsedRange.Offset(1, 0).Clear
    
23.     .Columns(1).NumberFormatLocal = "@"
    
24.     .Range("a2").Resize(d.Count, UBound(brr)) = Application.Transpose(Application.Transpose(d.items))
    
25.   End With
    
26. End Sub

复制代码

chxw68

猜测着做的。