求帮忙咯老师们谢谢！

谢谢我插个队

通过规格能直接找到库位和标准，麻烦大家了，谢谢！

谢谢我插个队

一共800行内容下面的没有全部添加

excelvlookup

用筛选或index函数，不就800行嘛。

hefuqing

1. Sub 查询系统()
   
2. Sheets("查询系统").Select
   
3. Dim sh As Worksheet, rng As Range, n%, sr As Variant
   
4. Dim arr()
   
5. sr = InputBox("请输入需要查询的条件")
   
6. If sr = "" Then Exit Sub
   
7. Sheets("查询系统").Range("A2:R10000").Delete
   
8. For Each sh In Worksheets
   
9. If sh.Name <> "查询系统" Then
   
10.   For Each rng In sh.[b2:b10000]
    
11.    If rng.Value Like "*" & sr & "*" Then
    
12.     n = n + 1
    
13.      ReDim Preserve arr(1 To n)
    
14.     arr(n) = rng.Offset(0, -1).Resize(1, 5)
    
15.    End If
    
16.   Next rng
    
17. End If
    
18. Next sh
    
19. If n = 0 Then Exit Sub
    
20. Sheets("查询系统").Range("A2").Resize(n, 5) = Application.Transpose(Application.Transpose(arr))
    
21. Sheets("查询系统").Range("A2:e" & n + 1).Borders.LineStyle = xlContinuous '加边框线
    
22. End Sub
    

复制代码

hefuqing

附件 查收 好的话给小花