求筛选多个数据后复制到新表上

hsldld

各位老师，我的bom表有几十万行（太大删掉了一部分），其中我有600多个BOM需要筛选“成品编码”出来复制到新表上，每个成品编码筛选出的BOM多行多列，求大神指教！

魂断蓝桥

成品编码
1.1.06.03.0006

这个应该返回的是？ 如果是多是多行数据，返回的格式是？

hsldld

抱歉，我以为说清楚了，我上传一个复制俩个编码的！复制在新表里

hefuqing

1. Sub text()
   
2. Dim brr()
   
3. Set d = CreateObject("scripting.dictionary")
   
4. arr = Sheet1.[a1].CurrentRegion
   
5. For i = 2 To Sheet2.[a65536].End(xlUp).Row
   
6. If Sheet2.Cells(i, 1) <> "" Then
   
7. d(Sheet2.Cells(i, 1).Value) = ""
   
8. End If
   
9. Next i
   
10. 
    
11. For i = 2 To UBound(arr)
    
12. If d.Exists(arr(i, 2)) Then
    
13. n = n + 1
    
14. ReDim Preserve brr(1 To UBound(arr, 2), 1 To n)
    
15. For m = 1 To UBound(arr, 2)
    
16. brr(m, n) = arr(i, m)
    
17. Next
    
18. End If
    
19. Next i
    
20. Sheet1.Range("a1:m1").Copy Sheet3.[a1]
    
21. Sheets("新表").[a2].Resize(UBound(brr, 2), UBound(brr)) = Application.Transpose(brr)
    
22. End Sub
    

复制代码

hsldld

感谢老师！