求高手帮忙，跨工作薄批量复制提取数据问题

nshk0898

zhaogang1960 发表于 2013-3-13 19:09
或使用instr函数:

非常感谢，基本能够实现我要的效果.您用的这种方法实在不懂，所以恳请能否再改下让查找的范围是整个“工作薄”而不仅是sheet1,不胜感激！（附件在10楼）

zhaogang1960

nshk0898 发表于 2013-3-14 11:08
非常感谢，基本能够实现我要的效果.您用的这种方法实在不懂，所以恳请能否再改下让查找的范围是整个“工作 ...

1. Sub 查找整个工作簿()
   
2.     Dim cnn As Object, rs As Object, SQL$, s$, n%
   
3.     Set cnn = CreateObject("ADODB.Connection")
   
4.     cnn.Open "provider=Microsoft.ACE.OLEDB.12.0;extended properties='excel 12.0;hdr=no';data source=" & ThisWorkbook.Path & "\456.xlsx"
   
5.     Set rs = cnn.OpenSchema(20)
   
6.     Do Until rs.EOF
   
7.         If rs.Fields("TABLE_TYPE") = "TABLE" Then
   
8.             s = Replace(rs("TABLE_NAME").Value, "'", "")
   
9.             If Right(s, 1) = "$" Then
   
10.                 n = n + 1
    
11.                 If n = 1 Then
    
12.                     SQL = "select * from [" & s & "]"
    
13.                 Else
    
14.                     SQL = SQL & " union all select * from [" & s & "]"
    
15.                 End If
    
16.             End If
    
17.         End If
    
18.         rs.MoveNext
    
19.     Loop
    
20.     SQL = "select iif(isnull(b.f1),'没有找到',b.f1),f2,f3 from [Excel 12.0;hdr=no;Database=" & ThisWorkbook.FullName & "].[Sheet1$A2:A" & Cells(Rows.Count, 1).End(xlUp).Row & "] a left join (" & SQL & ") b on instr(b.f3 ,a.f1)>0"
    
21.     [c2].CopyFromRecordset cnn.Execute(SQL)
    
22.     rs.Close
    
23.     Set rs = Nothing
    
24.     cnn.Close
    
25.     Set cnn = Nothing
    
26. End Sub

复制代码

zhaogang1960

请看附件
查找范围是整个工作薄.rar (25.2 KB, 下载次数: 22)

2013-3-14 12:11 上传

点击文件名下载附件

nshk0898

zhaogang1960 发表于 2013-3-14 12:11
请看附件

多谢，非常好用。

nshk0898

zhaogang1960 发表于 2013-3-14 12:09

因为查询原始数据较多，速度比较慢，如果加一个查询进度条或者提示栏，应该引用那个参数，还望老师指点，谢谢！

nshk0898

zhaogang1960 发表于 2013-3-14 12:11
请看附件

因为查询原始数据较多，速度比较慢，如果加一个查询进度条或者提示栏，应该引用那个参数，还望老师指点，谢谢！

zhaogang1960

nshk0898 发表于 2013-3-27 13:33
因为查询原始数据较多，速度比较慢，如果加一个查询进度条或者提示栏，应该引用那个参数，还望老师指点， ...

查找范围是整个工作薄.rar (30.77 KB, 下载次数: 13)

2013-3-27 15:36 上传

点击文件名下载附件

nshk0898

zhaogang1960 发表于 2013-3-27 15:36

查询条不起作用，程序运行后 excel 程序就会显示“未响应”，不能进行任何操作，但查询计算并没有停止，只能这种状态等待运算结束

zhaogang1960

nshk0898 发表于 2013-3-27 16:20
查询条不起作用，程序运行后 excel 程序就会显示“未响应”，不能进行任何操作，但查询计算并没有停止，只 ...

通常循环复制数据才加进度条，本题目只有一个动作，复制数据：
[c2].CopyFromRecordset cnn.Execute(SQL)
建议放弃加进度条，因为数据太多才出现时间很长

nshk0898

zhaogang1960 发表于 2013-3-27 16:39
通常循环复制数据才加进度条，本题目只有一个动作，复制数据：
[c2].CopyFromRecordset cnn.Execute(SQL ...

好的，谢谢！