怎样用VBA结合SQL实现多条件查询

kykykyky

只要三列字段值同时等于了sheet2中的三列的值，做复合条件查询，从sheet1表中的数据取出结果，放到新的SHEET3中。

只要这三列[Local/Import],[Model],[Model Year Description]的值等于了sheet2中的这三列的值，就从SHEET1中查询出来结果放到一个新的sheet3表中，我是这样写的，但不知道错哪了，请指教
Sub sqlquery()

Dim Cn As Object,  ar
ar = Sheet2.[a1].CurrentRegion
Application.ScreenUpdating = False
Set Cn = CreateObject("ADODB.Connection")
Cn.Open "Provider=Microsoft.ACE.OLEDB.12.0;Extended Properties=Excel 12.0;Data Source=" &

ThisWorkbook.FullName
Sq(1) = "[Export Worksheet (2)$]a"
'Sq(2) = "[Sheet1$]b"
Sq(0)="SELECT [VIN],[Local/Import],[Model],[Model Year Description],[Subscription Package]

FROM [Export Worksheet (2)$] WHERE [Local/Import]=sheet2.range("a2").value and [Model]=range

("b2").value and [Model Year Description]=range("c2").value
"
Worksheets("sheet3").Range("a2").CopyFromRecordset Cn.Execute(Sq(0))
Cn.Close
Set Cn = Nothing
Application.ScreenUpdating = False
MsgBox "OK!", 64

End Sub

kykykyky

请求各位老师给指导帮助

魂断蓝桥

Sub a()
Dim cnn, myf$, sql$
myf = ThisWorkbook.FullName
Set cnn = CreateObject("adodb.connection")
cnn.Open "Provider=Microsoft.ACE.OleDb.12.0;Extended Properties='Excel 12.0;HDR=YES'; Data Source=" & myf
sql = "SELECT [VIN],[Local/Import],[Model],[Model Year Description],[Subscription Package] FROM [Export Worksheet (2)$] " _
& " WHERE [Local/Import]='" & Sheet2.Range("c2") & "' and [Model]='" & Sheet2.Range("b2") & "' and [Model Year Description]='" & Sheet2.Range("a2") & "'"
Sheet3.Activate
Range("a2").CopyFromRecordset cnn.Execute(sql)
Set cnn = Nothing
End Sub

魂断蓝桥

代码审核中

潜行的卢瑟

1. Sub sqlquery()
   
2. 
   
3. Dim Cn As Object, ar
   
4. ar = Sheet2.[a1].CurrentRegion
   
5. Application.ScreenUpdating = False
   
6. Set Cn = CreateObject("ADODB.Connection")
   
7. Cn.Open "Provider=Microsoft.ACE.OLEDB.12.0;Extended Properties=Excel 12.0;Data Source=" & ThisWorkbook.FullName
   
8. 'Sq(1) = "[Export Worksheet (2)$]a"
   
9. 'Sq(2) = "[Sheet1$]b"
   
10. Sql = "SELECT [VIN],[Local/Import],[Model],[Model Year Description],[Subscription Package] FROM [Export Worksheet (2)$] WHERE [Local/Import]='" & Sheets("sheet1").[c2] & "' and [Model]='" & Sheets("sheet1").[b2] & "' and [Model Year Description]='" & Sheets("sheet1").[a2] & "'"
    
11. 'Sq(0) = "SELECT a.[VIN],a.[Local/Import],a.[Model],a.[Model Year Description],a[Subscription Package] FROM " & Sq(1) & " LEFT JOIN " & Sq(2) & " ON a.[VIN]=b.[Vin]"
    
12. Sheet3.Range("a2").CopyFromRecordset Cn.Execute(Sql)
    
13. Cn.Close
    
14. Set Cn = Nothing
    
15. Application.ScreenUpdating = False
    
16. MsgBox "OK!", 64
    
17. 
    
18. End Sub

复制代码

where 后面引用的用法错了，然后查找的单元格也错了，A2跟C2弄反了，最后是Worksheets("sheet3")错了，这里哪里有一个叫sheet3的表呢？应该是Sheet3.Range("a2")或者Worksheets("sheet2")。

潜行的卢瑟

不过，建议楼主用这个代码。

1. Sub start()
   
2. 
   
3. 
   
4. Application.ScreenUpdating = False
   
5.      Dim cn1 As ADODB.Connection
   
6.      Dim SQL1$
   
7.      Set cn1 = New ADODB.Connection
   
8.      Set rs1 = CreateObject("adodb.recordset")
   
9. 
   
10.      cn1.Open "provider=Microsoft.Ace.OLEDB.12.0;extended properties=excel 12.0;data source=" & ThisWorkbook.FullName
    
11.      SQL1 = "SELECT [VIN],[Local/Import],[Model],[Model Year Description],[Subscription Package] FROM [Export Worksheet (2)$]" _
    
12.         & "WHERE [Local/Import]='" & Sheet2.Range("c2") & "' and [Model]='" & Sheet2.Range("b2") & "' and [Model Year Description]='" & Sheet2.Range("a2") & "'"
    
13.      Set rs1 = cn1.Execute(SQL1)
    
14.          With Sheets("Sheet2")
    
15.            .Cells.ClearContents
    
16.             For i = 1 To rs1.Fields.Count
    
17.              .Cells(1, i) = rs1.Fields(i - 1).Name
    
18.             Next
    
19.              .Range("a2").CopyFromRecordset rs1
    
20.          End With
    
21.      cn1.Close: Set cn1 = Nothing
    
22.      Application.ScreenUpdating = True
    
23. End Sub

复制代码

kykykyky

感谢两位老师，受教了，感谢！！

ph378

学习学习，收藏了

ww09152010

认真学习才能进步