请问如何遍历同一个文件夹查找

bajifeng

529905149 发表于 2016-3-19 14:19
bajifeng老师，可以把按钮1去掉，改为B1单元格值改变后得到结果吗？

当然可以，改成change事件就可以了。

bajifeng

529905149 发表于 2016-3-19 14:19
bajifeng老师，可以把按钮1去掉，改为B1单元格值改变后得到结果吗？

当然可以，改成change事件就可以了。

529905149

bajifeng 发表于 2016-3-19 14:37
当然可以，改成change事件就可以了。

Private Sub Worksheet_Change(ByVal Target As Range)
  Call 查询
End Sub
运行时错误：
With Workbooks.Open(ipath & fn)

bajifeng

1. Private Sub Worksheet_Change(ByVal Target As Range)
   
2.     If Target.Address <> "$B$1" Then Exit Sub
   
3.     Dim br(), ar, i%, j%, n&, fn$, ipath$
   
4.     Application.ScreenUpdating = False
   
5.     w = Target.Value
   
6.     ipath = ThisWorkbook.Path & ""
   
7.     fn = Dir(ipath & "*.xls?")
   
8.     Do
   
9.         If Not fn Like ThisWorkbook.Name Then
   
10.             With Workbooks.Open(ipath & fn)
    
11.                 For Each sht In .Worksheets
    
12.                     ar = sht.Range("a3:i" & sht.[a65536].End(3).Row)
    
13.                     For i = 1 To UBound(ar)
    
14.                         If InStr(ar(i, 2), w) > 0 Then
    
15.                             n = n + 1
    
16.                             ReDim Preserve br(1 To 10, 1 To n)
    
17.                             br(1, n) = sht.Name
    
18.                             For j = 1 To 9
    
19.                                 br(1 + j, n) = ar(i, j)
    
20.                             Next
    
21.                         End If
    
22.                     Next
    
23.                 Next
    
24.                 .Close False
    
25.             End With
    
26.         End If
    
27.         fn = Dir
    
28.     Loop While fn <> ""
    
29.     [a3:j65536] = ""
    
30.     [a3].Resize(n, 10) = Application.Transpose(br)
    
31.     Application.ScreenUpdating = True
    
32. End Sub

复制代码

bajifeng

>>>>>>>>>>>>>>>>>>>>>>

529905149

bajifeng 发表于 2016-3-19 14:47

运行时错误：
With Workbooks.Open(ipath & fn)

529905149

bajifeng 发表于 2016-3-19 14:51
>>>>>>>>>>>>>>>>>>>>>>

谢谢老师，解决大问题了。

bajifeng

529905149 发表于 2016-3-19 14:46
Private Sub Worksheet_Change(ByVal Target As Range)
  Call 查询
End Sub

你这改法未必有点偷懒的嫌疑
去15楼下载我的附件吧。

529905149

bajifeng 发表于 2016-3-19 14:54
你这改法未必有点偷懒的嫌疑
去15楼下载我的附件吧。

如果表中没有B1单元格的关键字，则提示
[a3].Resize(n, 10) = Application.Transpose(br)
比如在B1单元格输入“哈哈”

bajifeng

在这句前加上一句 if n=0 then end