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

529905149

在同一个文件夹下，一个查询表，多个数据表，使用查询表如何进行多表查询呢？谢谢。

zhaogang1960

ADO法速度较快，请参考：
Private Sub Worksheet_Change(ByVal Target As Range)
    If Target.Address <> "$B$1" Then Exit Sub
    Application.ScreenUpdating = False
    Range("A3:Z65536").ClearContents
    If Len(Range("B1")) = 0 Then Exit Sub
    Dim cnn As Object, rs As Object, SQL$, s$, MyPath$, MyFile$, m&
    Columns("E:E").NumberFormatLocal = "@"
    MyPath = ThisWorkbook.Path & "\"
    MyFile = Dir(MyPath & "*.xls*")
    Do While MyFile <> ""
        If InStr(MyFile, ThisWorkbook.Name) = 0 Then
            Set cnn = CreateObject("ADODB.Connection")
            cnn.Open "Provider=Microsoft.Ace.OLEDB.12.0;Extended Properties=Excel 12.0;Data Source=" & MyPath & MyFile
            Set rs = cnn.OpenSchema(20)
            Do Until rs.EOF
                If rs.Fields("TABLE_TYPE") = "TABLE" Then
                    s = Replace(rs("TABLE_NAME").Value, "'", "")
                    If Right(s, 1) = "$" Then
                        SQL = "select * from [" & s & "a2:j] where 姓名 like '%" & Target & "%'"
                        Range("a65536").End(xlUp).Offset(1).CopyFromRecordset cnn.Execute(SQL)
                    End If
                End If
                rs.MoveNext
            Loop
        End If
        MyFile = Dir()
    Loop
    cnn.Close
    Set cnn = Nothing
    Application.ScreenUpdating = True
End Sub

zhaogang1960

请测试附件
遍历当前文件夹查询.rar (422.72 KB, 下载次数: 73)

2016-3-19 14:06 上传

点击文件名下载附件

529905149

运行时错误“3706”
cnn.Open "Provider=Microsoft.Ace.OLEDB.12.0;Extended Properties=Excel 12.0;Data Source=" & MyPath & MyFile

bajifeng

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

复制代码

bajifeng

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

529905149

bajifeng老师，可以把按钮1去掉，改为B1单元格值改变后得到结果吗？

bajifeng

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

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

bajifeng

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

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

bajifeng

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

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