VBA第二种方法不要用find实现 跨表搜索

laoau138

VBA第二种方法不要用find实现 跨表搜索

dsmch

1. Sub 查询()
   
2. Dim arr, brr, i%, j&, k%
   
3. [A:F].Clear   '清除上次的查询结果
   
4. ReDim brr(1 To 20000, 1 To 6)
   
5. 姓名 = Application.InputBox("您想查找谁的成绩？可以输入一个或者多字", "查找目标", , , , , , 2)    '在输入框中指定查找目标
   
6. If 姓名 = "False" Then Exit Sub    '如果用户按下了取消键，那么结束过程
   
7. Tim = Timer  '初始化时间变量
   
8. For i = 1 To Sheets.Count - 1   '遍历所有工作表（当前存放结果的工作表即除外）
   
9.     arr = Sheets(i).Range("a1").CurrentRegion
   
10.     For j = 2 To UBound(arr)
    
11.         If arr(j, 1) Like "*" & 姓名 & "*" Then
    
12.             s = s + 1
    
13.             brr(s, 1) = Sheets(i).Name
    
14.             brr(s, 2) = Cells(j, 1).Address(0, 0)
    
15.             For k = 1 To 4
    
16.                 brr(s, k + 2) = arr(j, k)
    
17.             Next
    
18.         End If
    
19.    Next
    
20. Next
    
21. If s Then
    
22.     [a1:f1] = Array("工作表", "地址", "姓名", "班级", "学号", "成绩")
    
23.     Range("a2").Resize(s, 6) = brr
    
24. End If
    
25. MsgBox Format(Timer - Tim, "0.00秒")    '提示搜索时间(仅用于测试，实际工作中可以不要这句代码)
    
26. End Sub

复制代码

laoau138

dsmch 发表于 2016-11-15 14:13

不太明白你的代码

laoau138

dsmch 发表于 2016-11-15 14:13

VBA实现多工作簿自动汇总

http://www.excelpx.com/thread-425669-1-1.html