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

nshk0898

我的问题是 将工作薄123.xls的sheet1 A列中的数据作为查询条件，去工作薄456.xls中查找匹配的单元格，并将此单元格所在行数据复制粘贴到工作薄123.xls sheet1中，如查找不到结果，返回“没有找到”。求高数帮帮，在线等，谢谢！！

lzyamo3057

查询的条件，对应的是不是唯一值？也就是一个条件对应一个人？

nshk0898

lzyamo3057 发表于 2013-3-13 15:15
查询的条件，对应的是不是唯一值？也就是一个条件对应一个人？

不一定是一对一，工作薄456中的数据可能存在重复数据。不要求删除，只要查找的一个并复制过来就可以了，谢谢。

zhaogang1960

ADO法请测试：

1. Sub ADO法()
   
2.     Dim cnn As Object, SQL$
   
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.     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 [Sheet1$] b on a.f1=b.f3"
   
6.     [c2].CopyFromRecordset cnn.Execute(SQL)
   
7.     cnn.Close
   
8.     Set cnn = Nothing
   
9. End Sub
   

复制代码

zhaogang1960

ADO法对数据类型要求严格，但可以避开Open工作簿这一过程，速度较快
请看附件
Desktop.rar (24.05 KB, 下载次数: 46)

2013-3-13 17:19 上传

点击文件名下载附件

nshk0898

zhaogang1960 发表于 2013-3-13 17:19
ADO法对数据类型要求严格，但可以避开Open工作簿这一过程，速度较快
请看附件

高手啊！多谢了

nshk0898

zhaogang1960 发表于 2013-3-13 17:19
ADO法对数据类型要求严格，但可以避开Open工作簿这一过程，速度较快
请看附件

你好，我试了下速度很快，但是有一个问题是，查找时必须是完全匹配，能不能实现像 find()函数一样，源数据是“123456”，查找“123”也可以找到，这种方法可否实现，谢谢！

zhaogang1960

nshk0898 发表于 2013-3-13 18:59
你好，我试了下速度很快，但是有一个问题是，查找时必须是完全匹配，能不能实现像 find()函数一样，源数据 ...

1. Sub ADO法()
   
2.     Dim cnn As Object, SQL$
   
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.     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 [Sheet1$] b on b.f3 like '%'&a.f1&'%'"
   
6.     [c2].CopyFromRecordset cnn.Execute(SQL)
   
7.     cnn.Close
   
8.     Set cnn = Nothing
   
9. End Sub

复制代码

zhaogang1960

或使用instr函数:

1. 
   
2. Sub ADO法2()
   
3.     Dim cnn As Object, SQL$
   
4.     Set cnn = CreateObject("ADODB.Connection")
   
5.     cnn.Open "provider=Microsoft.ACE.OLEDB.12.0;extended properties='excel 12.0;hdr=no';data source=" & ThisWorkbook.Path & "\456.xlsx"
   
6.     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 [Sheet1$] b on instr(b.f3 ,a.f1)>0"
   
7.     [c2].CopyFromRecordset cnn.Execute(SQL)
   
8.     cnn.Close
   
9.     Set cnn = Nothing
   
10. End Sub
    

复制代码

Desktop.rar (25.87 KB, 下载次数: 20)

2013-3-13 19:09 上传

点击文件名下载附件

nshk0898

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