vbscript VBA Excel交叉连接多个工作表而不重复

Posted 2021-05-22

Sub CrossJoinSheets()
    Dim cn As ADODB.Connection
    Dim sql As String
    Dim outputSheet As Worksheet
    Dim rs As ADODB.Recordset
    Set rs = New ADODB.Recordset
    Set cn = New ADODB.Connection
    With cn
        .ConnectionString = "Provider=Microsoft.ACE.OLEDB.12.0;" & _
              "Data Source=" & ActiveWorkbook.FullName & ";" & _
              "Extended Properties=""Excel 12.0 XML;HDR=Yes"""
        .Open
    End With
    sql = "SELECT DISTINCT * FROM [Sheet1$], [Sheet2$], [Sheet3$]"
    rs.Open sql, cn
    Set outputSheet = Sheets.Add
    outputSheet.Name = "CrossJoined"
    outputSheet.Range("A1").CopyFromRecordset rs
    rs.Close
    cn.Close
 End Sub