[已解决]按条件查找数据的问题求助高手

小小玩童

附件 按条件查找.rar (204.41 KB, 下载次数: 28)

2014-8-11 20:10 上传

点击文件名下载附件
谢谢老师！

最佳答案

月排行榜 / 总排行榜

xdragon

2014-8-11 21:19

1. Sub Test()
   
2.     Dim Conn As Object, Rst As Object
   
3.     Dim strConn As String, SQL As String
   
4.     Dim i As Integer, PathStr As String
   
5.     Set Conn = CreateObject("ADODB.Connection")
   
6.     Set Rst = CreateObject("ADODB.Recordset")
   
7.     PathStr = ThisWorkbook.FullName
   
8.     Select Case Application.Version * 1
   
9.     Case Is <= 11
   
10.         strConn = "Provider=Microsoft.Jet.Oledb.4.0;Extended Properties=excel 8.0;Data source=" & PathStr
    
11.     Case Is >= 12
    
12.         strConn = "Provider=Microsoft.ACE.OLEDB.12.0;Data Source=" & PathStr & ";Extended Properties=""Excel 12.0;HDR=NO"";"""
    
13.     End Select
    
14.     Conn.Open strConn
    
15.     SQL = "select b.F1,b.F2,b.F3,b.F4,b.F5 from [Sheet1$]a left join [Sheet2$]b on a.F2=b.F2 and a.F4=b.F4 and a.F5=b.F5"
    
16.     Set Rst = Conn.Execute(SQL)
    
17.     With Sheet3
    
18.         .Cells.Clear
    
19.         .Range("A1").CopyFromRecordset Rst
    
20.     End With
    
21.     Rst.Close
    
22.     Conn.Close
    
23.     Set Conn = Nothing
    
24.     Set Rst = Nothing
    
25. End Sub

复制代码

跳转到最佳答案楼层

tgydslr

好像这个用公式也可以做的，试过了，数据少的时候速度上还可以，没用大数据试过
sheet3！A1=INDEX(Sheet2!A:A,SMALL(IF((TRANSPOSE(Sheet1!$B$1:$B$4)=Sheet2!$B$1:$B$747)*(TRANSPOSE(Sheet1!$D$1:$D$4)=Sheet2!$D$1:$D$747)*(TRANSPOSE(Sheet1!$E$1:$E$4)=Sheet2!$E$1:$E$747),ROW($1:$747),4^10),ROW()))&“”三键横拉下拉

tgydslr

按条件查找.rar (206.32 KB, 下载次数: 8)

2014-8-11 21:01 上传

点击文件名下载附件

易安1

高筛

小小玩童

tgydslr 发表于 2014-8-11 21:01

谢谢老师帮助。表2的数据多的时候，达几十万行，公式有点力不从心啊。希望有代码一键解决。

tgydslr

小小玩童 发表于 2014-8-11 21:07
谢谢老师帮助。表2的数据多的时候，达几十万行，公式有点力不从心啊。希望有代码一键解决。

不好意思，俺的代码很菜，写出来还不如公式呢，还是等楼下的给出代码吧

xdragon

1. Sub Test()
   
2.     Dim Conn As Object, Rst As Object
   
3.     Dim strConn As String, SQL As String
   
4.     Dim i As Integer, PathStr As String
   
5.     Set Conn = CreateObject("ADODB.Connection")
   
6.     Set Rst = CreateObject("ADODB.Recordset")
   
7.     PathStr = ThisWorkbook.FullName
   
8.     Select Case Application.Version * 1
   
9.     Case Is <= 11
   
10.         strConn = "Provider=Microsoft.Jet.Oledb.4.0;Extended Properties=excel 8.0;Data source=" & PathStr
    
11.     Case Is >= 12
    
12.         strConn = "Provider=Microsoft.ACE.OLEDB.12.0;Data Source=" & PathStr & ";Extended Properties=""Excel 12.0;HDR=NO"";"""
    
13.     End Select
    
14.     Conn.Open strConn
    
15.     SQL = "select b.F1,b.F2,b.F3,b.F4,b.F5 from [Sheet1$]a left join [Sheet2$]b on a.F2=b.F2 and a.F4=b.F4 and a.F5=b.F5"
    
16.     Set Rst = Conn.Execute(SQL)
    
17.     With Sheet3
    
18.         .Cells.Clear
    
19.         .Range("A1").CopyFromRecordset Rst
    
20.     End With
    
21.     Rst.Close
    
22.     Conn.Close
    
23.     Set Conn = Nothing
    
24.     Set Rst = Nothing
    
25. End Sub

复制代码

小小玩童

xdragon 发表于 2014-8-11 21:19

老师您好，谢谢您帮助。试了一下代码，发现出来的结果，少了后面两列。即：没有把整个一个的数据，提取出来。如下图


完整结果应为：



不知能否修正一下？谢谢了。

xdragon

SQL = "select b.F1,b.F2,b.F3,b.F4,b.F5,b.F6,b.F7 from [Sheet1$]a left join [Sheet2$]b on a.F2=b.F2 and a.F4=b.F4 and a.F5=b.F5"

把这句稍微修改下就好了