新手想做一个可以查找多个文件的excel，求大家帮忙！

伊~水

想做个excel，然后在其中可以选择所要查找的多个excel（getfilename好像只能插入一个啊），然后输入想要查找的内容。
就会出现关键字在哪个excel中出现。
希望大家可以帮帮忙，教教我该如何实现。

zhaogang1960

MyFile = Application.GetOpenFilename(fileFilter:="Excel文件(*.xls),*.xls", Title:="选择Excel文件", MultiSelect:=True)'MultiSelect:=True——多选
If TypeName(MyFile) = "Boolean" Then Exit Sub

如果工作簿很多，建议使用ADO联合查询：

【83期】VBA多工作簿多工作表数据查询[已小结]
http://club.excelhome.net/thread-781055-2-1.html

伊~水

zhaogang1960 发表于 2013-1-16 17:48
MyFile = Application.GetOpenFilename(fileFilter:="Excel文件(*.xls),*.xls", Title:="选择Excel文件",  ...

我这要查询的里面不仅有.xls文件，还有.csv文件。你推荐的那个我看了，不过我不想要里面的数据，我只想查询关键字是否出现，在哪个表里出现。还请帮帮忙，给个代码，教我一下。感谢！

zhaogang1960

伊~水 发表于 2013-1-17 09:29
我这要查询的里面不仅有.xls文件，还有.csv文件。你推荐的那个我看了，不过我不想要里面的数据，我只想查 ...

请说明在那里查找关键字，并上传要查找的.xls文件、.csv文件，模拟要达到的效果

伊~水

zhaogang1960 发表于 2013-1-17 10:00
请说明在那里查找关键字，并上传要查找的.xls文件、.csv文件，模拟要达到的效果

文件太大了，传不上去啊。。。就比如说有个1.xlsx和一个2.csv，里面有一些公司名称的数据，我想新做个excel，然后输入想要查找的公司名称，就知道1还是2里面出现过这个公司。

zhaogang1960

伊~水 发表于 2013-1-17 13:24
文件太大了，传不上去啊。。。就比如说有个1.xlsx和一个2.csv，里面有一些公司名称的数据，我想新做个exc ...

传个截图看看在哪个字段中查找公司名

zhaogang1960

假设都有“公司名称”字段，查找该字段是否存在指定公司名称，如果有则列出文件名、工作表名(xls文件)：

1. Sub Macro1()
   
2.     Dim cnn As Object, cnncsv As Object, cat As Object, rs As Object, SQL$, MyFile, arr$(), i&, m&, n&
   
3.     ChDrive Split(ThisWorkbook.Path, ":")(0)
   
4.     ChDir ThisWorkbook.Path
   
5.     MyFile = Application.GetOpenFilename(fileFilter:="xls、csv文件(*.xls;*.csv),*.xls;*.csv", Title:="选择xls、csv文件", MultiSelect:=True) 'MultiSelect:=True——多选
   
6.     If TypeName(MyFile) = "Boolean" Then Exit Sub
   
7.     ReDim arr(1 To UBound(MyFile), 1 To 2)
   
8.     temp = [b2]
   
9.     Application.ScreenUpdating = False
   
10.     myPath = ThisWorkbook.Path & ""
    
11.     Set cnn = CreateObject("adodb.connection")
    
12.     Set cat = CreateObject("ADOX.Catalog")
    
13.     Set cnncsv = CreateObject("adodb.connection")
    
14.     cnncsv.Open ConnectionString:="Provider=MSDASQL;Driver={Microsoft Text Driver (*.txt; *.csv)};DBQ=" & myPath
    
15.     For i = 1 To UBound(MyFile)
    
16.         If MyFile(i) <> ThisWorkbook.FullName Then
    
17.             If LCase(MyFile(i)) Like "*.xls" Then
    
18.                 n = n + 1
    
19.                 If n = 1 Then cnn.Open "Provider=Microsoft.Jet.OLEDB.4.0;Extended Properties=Excel 8.0;Data Source=" & MyFile(i)
    
20.                 cat.ActiveConnection = "Provider=Microsoft.Jet.OLEDB.4.0;Extended Properties='Excel 8.0;HDR=No';Data Source=" & MyFile(i)
    
21.                 For Each tb1 In cat.Tables
    
22.                     If tb1.Type = "TABLE" Then
    
23.                         s = Replace(tb1.Name, "'", "")
    
24.                         If Right(s, 1) = "[        DISCUZ_CODE_0        ]quot; Then
    
25.                             SQL = "select * from [Excel 8.0;Database=" & MyFile(i) & "].[" & s & "] where 公司名称='" & temp & "'"
    
26.                             Set rs = CreateObject("adodb.recordset")
    
27.                             rs.Open SQL, cnn, 1, 3
    
28.                             If rs.RecordCount Then
    
29.                                 m = m + 1
    
30.                                 a = Split(MyFile(i), "")
    
31.                                 arr(m, 1) = a(UBound(a))
    
32.                                 arr(m, 2) = s
    
33.                                 Exit For
    
34.                             End If
    
35.                         End If
    
36.                     End If
    
37.                 Next
    
38.             ElseIf LCase(MyFile(i)) Like "*.csv" Then
    
39.                 SQL = "select * from " & MyFile(i) & " where 公司名称='" & temp & "'"
    
40.                 Set rs = CreateObject("adodb.recordset")
    
41.                 rs.Open SQL, cnncsv, 1, 3
    
42.                 If rs.RecordCount Then
    
43.                     m = m + 1
    
44.                     a = Split(MyFile(i), "")
    
45.                     arr(m, 1) = a(UBound(a))
    
46.                 End If
    
47.             End If
    
48.         End If
    
49.     Next
    
50.     Range("A4:B65536").ClearContents
    
51.     Range("A4").Resize(m, 2) = arr
    
52.     Set cat = Nothing
    
53.     Set tb1 = Nothing
    
54.     rs.Close
    
55.     Set rs = Nothing
    
56.     cnn.Close
    
57.     Set cnn = Nothing
    
58.     cnncsv.Close
    
59.     Set cnncsv = Nothing
    
60.     Application.ScreenUpdating = True
    
61. End Sub
    

复制代码

zhaogang1960

给你做一个附件
查找含有指定公司名称的xls、csv文件.rar (20.57 KB, 下载次数: 63)

2013-1-17 16:57 上传

点击文件名下载附件

Jick.Ji

新人，标记学习！！！！！！！！！

LMY123

              cat.ActiveConnection = "Provider=Microsoft.Jet.OLEDB.4.0;Extended Properties='Excel 8.0;HDR=No';Data Source=" & MyFile(i)