VBA：ADO连接excel配合SQL操作

excel里sheet1的ambass栏要填，site栏是key。和sheet2 sheet3有一对一关系，最后从sheet3得出ambass填入sheet1。纯表操作用sql来做非常方便，整个方法跑下来只需要3秒就跑完了，没有VBA众多循环判断关系，简单的select update两句即可。

需要注意的重点：

vba里外连接异常困难，3个表或以上的内加外连接难以实现。我尝试了很久最终还是放弃了，用回简单的内连接，增加sql语句数，一样可以实现。
excel里为空的单元格，既不是null，也不是''，也不是' '，也没有字符串长度，也没有类型，我不能选中它们，大神们有办法请告知
VBA里不可用delete语句，真要delete只能曲线救国，用update set栏位为null

select语句的输出：

    strsql1 = "select distinct A.[Site],C.[CA] from [Sheet1$] A ,[location$] C where A.[Site]=C.[Local]" 
    Set Rst = Conn.Execute(strsql1)  --rst为执行sql之后的表
    Sheets("Output").Range("A2").CopyFromRecordset Rst --把rst输出到sheet（output）里，A2单元格开始，关键字CopyFromRecordset

update语句则更简单，只要执行就好：

  Set Rst = Conn.Execute("update [Sheet1$] A,[Output$] B set A.[Ambassador]=B.[B] where A.[Site]=B.[A]")

三个表的内加外连接，能跑，但结果并不准确，随意感受一下：

"select A.[English Name],C.[CA],C.[Location 2] from ([Sheet1$] A left join [condition$] B on A.[Site]=B.[qw])inner join [location$] C on B.[er]=C.[Location] and A.[Site]=C.[Location 2]"

以下是完整代码

Sub Query()
    Dim Conn As Object, Rst As Object
    Dim strConn As String, strSQL As String, strsql1 As String
    Dim i As Integer, PathStr As String
    Set Conn = CreateObject("ADODB.Connection")
    Set Rst = CreateObject("ADODB.Recordset")
    PathStr = ThisWorkbook.FullName
    Select Case Application.Version * 1 --不同版本的excel要用不同的连接串
    Case Is <= 11
        strConn = "Provider=Microsoft.Jet.Oledb.4.0;Extended Properties=excel 8.0;Data source=" & PathStr
    Case Is >= 12
        strConn = "Provider=Microsoft.ACE.OLEDB.12.0;Data Source=" & PathStr & ";Extended Properties=""Excel 12.0;HDR=YES"";"""
    End Select
    
    Conn.Open strConn
    --第一part
    strSQL = "select distinct A.[Site],C.[AM] from [Sheet1$] A ,[condition$] B,[location$] C where A.[Site]=B.[site] and  B.[verdict]=C.[Location] " 'first select
    Set Rst = Conn.Execute(strSQL)
    Sheets("Output").Range("A2").CopyFromRecordset Rst 'input
    Set Rst = Conn.Execute("update [Sheet1$] A,[Output$] B set A.[Ambassador]=B.[B] where A.[Site]=B.[A]") 'update ambass
    Set Rst = Conn.Execute("update [Output$] set A=null,B=null") 'clear sheet
    --第二part
    strsql1 = "select distinct A.[Site],C.[AM] from [Sheet1$] A ,[location$] C where A.[Site]=C.[Local]" 'second select
    Set Rst = Conn.Execute(strsql1)
    Sheets("Output").Range("A2").CopyFromRecordset Rst 'input
    Set Rst = Conn.Execute("update [Sheet1$] A,[Output$] B set A.[Ambassador]=B.[B] where A.[Site]=B.[A]") 'update ambass
    Set Rst = Conn.Execute("update [Output$] set A=null,B=null") 'clear sheet
    strSQL = ""--释放
    strsql1 = ""
    Conn.Close
    Set Conn = Nothing
    Set Rst = Nothing
End Sub

VBA：ADO连接excel配合SQL操作

需要注意的重点：

猜你喜欢