多个工作簿内容查询

janemark

假如文件夹li123中有50个工作簿
我要在50个工作簿中查询“张三”，要一个个的打开查吗，有其他更好的办法没有？

maoboybaba

工作簿文件是保存在硬盘的，不打开如何读取。

xiangbaoan

可以不打开，没附件……

janemark

maoboybaba 发表于 2021-12-24 17:08
工作簿文件是保存在硬盘的，不打开如何读取。

没有更好的方法吗

盼盼198310

可以用dir函数试试

janemark

xiangbaoan 发表于 2021-12-24 17:20
可以不打开，没附件……

文件夹中有几个工作簿，在这些工作簿中查询所需要的字符。

在表“查询”中B1输入字符如“钢架”，那么如何得到查询表的信息呢？

xiangbaoan

1. Sub test1()
   
2.   Dim Cnn As Object, Cel As Range, Dict As Object
   
3.   Dim SQL As String, p As String, f As String, s As String
   
4.   
   
5.   Range("A1").CurrentRegion.Offset(2).ClearContents
   
6.   Application.ScreenUpdating = False
   
7.   
   
8.   Set Cel = Range("A3")
   
9.   Set Dict = CreateObject("Scripting.Dictionary")
   
10.   Set Cnn = CreateObject("ADODB.Connection")
    
11.   
    
12.   s = "Excel 12.0;HDR=no;Database="
    
13.   If Application.Version < 12 Then
    
14.     Cnn.Open "Provider=Microsoft.Jet.OLEDB.4.0;Extended Properties=Excel 8.0;Data Source=" & ThisWorkbook.FullName
    
15.     s = Replace(s, "12.0", "8.0")
    
16.   Else
    
17.     Cnn.Open "Provider=Microsoft.ACE.OLEDB.12.0;Extended Properties=Excel 12.0;Data Source=" & ThisWorkbook.FullName
    
18.   End If
    
19.   
    
20.   p = ThisWorkbook.Path & "\"
    
21.   f = Dir(p & "*.xls?")
    
22.   SQL = "SELECT f1,f2,f5,'[s]' FROM [" & s & p & "[f]].[$C4:G] WHERE f1 LIKE '%" & Range("b1").Value & "%'"
    
23.   
    
24.   While Len(f)
    
25.     If f <> ThisWorkbook.Name Then
    
26.       s = Split(f, ".")(0)
    
27.       Dict.Add Replace(Replace(SQL, "[s]", s), "[f]", f), vbNullString
    
28.       If Dict.Count Mod 49 = 0 Then
    
29.         Cel.CopyFromRecordset Cnn.Execute(Join(Dict.Keys, " UNION ALL "))
    
30.         Set Cel = Cells(Rows.Count, 1).End(xlUp).Offset(1)
    
31.         Dict.RemoveAll
    
32.       End If
    
33.     End If
    
34.     f = Dir
    
35.   Wend
    
36.   If Dict.Count Then Cel.CopyFromRecordset Cnn.Execute(Join(Dict.Keys, " UNION ALL "))
    
37.   
    
38.   Cnn.Close
    
39.   Set Cnn = Nothing
    
40.   Set Cel = Nothing
    
41.   Set Dict = Nothing
    
42.   Application.ScreenUpdating = True
    
43.   Beep
    
44. End Sub

复制代码

xiangbaoan

janemark 发表于 2021-12-25 08:27
文件夹中有几个工作簿，在这些工作簿中查询所需要的字符。

在表“查询”中B1输入字符如“钢架”，那么 ...

多个工作簿查询.zip (75.04 KB, 下载次数: 34)

2021-12-25 09:14 上传

点击文件名下载附件

janemark

xiangbaoan 发表于 2021-12-25 09:14

运行错误3706

janemark

xiangbaoan 发表于 2021-12-25 09:14

运行错误，不知什么原因