Question

使用Excel VBA我希望能够将excel中的两个表与一个公共密钥组合在一起。我已经建议将ADODB作为一种方法，但我对任何其他更有效/更优雅的方法都持开放态度。请参阅下面的最小示例：

我从下面开始......

Sheet 1中

    A     B       C
 1 type year1   year2
 2 aaa  100     110
 3 bbb  220     240
 4 ccc  304     200
 5 ddd  20      30
 6 eee  440     20

Sheet 2中

    A     B       C
 1 type year1   year2
 2 bbb  10      76
 3 ccc  44      39
 4 ddd  50      29
 5 eee  22      23
 6 fff  45      55

并希望将它结合起来，以便我得到以下结果：

表Sheet 3

    A     B       C       D       E
 1 type year1   year2   year1   year2
 2 aaa  100      110      0       0
 3 bbb  220      240      10      76
 4 ccc  304      200      44      39
 5 ddd  20       30       50      29
 6 eee  440      20       22      23
 7 fff  0        0        45      55

已经完成了一些谷歌搜索和SQL类型的外连接似乎很接近但不确定如何实现它。

以下是目前用于尝试和实施它的代码......

Option Explicit



Sub JoinTables()

 Dim cn As ADODB.Connection
 Set cn = New ADODB.Connection


 With cn
     .Provider = "Microsoft.Jet.OLEDB.4.0"
     .ConnectionString = "Data Source=" & ThisWorkbook.FullName & ";" & _
         "Extended Properties=Excel 8.0;"
     .Open
 End With

 Dim rs As ADODB.Recordset
 Set rs = New ADODB.Recordset

 rs.Open "SELECT * FROM [Sheet1$] OUTER JOIN [Sheet2$] ON [Sheet1$].[type] = " & _
     "[Sheet2$].[type]", cn

 With Worksheets("Sheet3")
     .Cells(2, 1).CopyFromRecordset rs
 End With

 rs.Close
 cn.Close

 End Sub

Answer 1

根据您是否在两个工作表上都有重复值，我可以想到一些想法，但不是使用SQL。

获取SourceSheet1的LastRow＆amp; SourceSheet2 - 将它们设置为变量lastRow1＆amp; lastRow2
为每个工作表创建一个行代码。 s1Row，s2Row，tRow
set tRow = 2对于TargetSheet的第一行
使用For循环遍历SourceSheet1的每一行。使用类似这样的东西
当代码的第一部分完成循环时，您将完成将SourceSheet1中的每个项目添加到TargetSheet。然后，您必须检查SourceSheet2中的值，以查看该列表中是否有任何唯一值。
完成后，您应该只添加初始搜索中缺少的那些。然后targetSheet将按SourceSheet1 All Items的顺序排列，然后是SourceSheet2中的额外项目

SET VARIABLES

Private Sub JoinLists()

Dim rng As Range
Dim typeName As String
Dim matchCount As Integer
Dim s1Row As Integer
Dim s2Row As Integer
Dim tRow As Integer
Dim m As Integer
Dim lastRow1 As Integer
Dim lastRow2 As Integer
Dim SourceSheet1 As String
Dim SourceSheet2 As String
Dim TargetSheet As String

SourceSheet1 = "Source1"
SourceSheet2 = "Source2"
TargetSheet = "Target"

tRow = 2

lastRow1 = Sheets(SourceSheet1).Range("A65536").End(xlUp).row
lastRow2 = Sheets(SourceSheet2).Range("A65536").End(xlUp).row

阶段一：将每个条目从Sheet1复制到Target，同时从Sheet2中抓取匹配项

Set rng = Sheets(SourceSheet2).Range("A2:A" & lastRow2)

For s1Row = 2 To lastRow1
    typeName = Sheets(SourceSheet1).Cells(s1Row, 1)
    matchCount = Application.WorksheetFunction.CountIf(rng, typeName)

    'Set the Row up on the TargetSheet. No matter if it's a match.
    Sheets(TargetSheet).Cells(tRow, 1) = typeName
    Sheets(TargetSheet).Cells(tRow, 2) = Sheets(SourceSheet1).Cells(s1Row, 2)
    Sheets(TargetSheet).Cells(tRow, 3) = Sheets(SourceSheet1).Cells(s1Row, 3)

    'Check to see if there are any matches on SourceSheet2

    If matchCount = 0 Then
    'There are NO matches.  Add Zeros to the extra columns
        Sheets(TargetSheet).Cells(tRow, 4) = 0
        Sheets(TargetSheet).Cells(tRow, 5) = 0
    Else
       'Get first matching occurance on the SourceSheet2
        m = Application.WorksheetFunction.Match(typeName, rng, 0)
        'Get Absolute Row number of that match
        s2Row = m + 1    ' This takes into account the Header Row, as index 1 is Row 2 of the search Range
        'Set the extra columns on TargetSheet to the Matches on SourceSheet2
        Sheets(TargetSheet).Cells(tRow, 4) = Sheets(SourceSheet1).Cells(s2Row, 2)
        Sheets(TargetSheet).Cells(tRow, 5) = Sheets(SourceSheet1).Cells(s2Row, 3)
    End If

    tRow = tRow + 1
Next s1Row

第二阶段：检查SourceSheet2以查找不在Sheet1上的条目

Set rng = Sheets(SourceSheet1).Range("A2:A" & lastRow1)

For s2Row = 2 To lastRow2
    typeName = Sheets(SourceSheet2).Cells(s2Row, 1)
    matchCount = Application.WorksheetFunction.CountIf(rng, typeName)

    If matchCount = 0 Then
    'There are NO matches.  Add to Target Sheet
        Sheets(TargetSheet).Cells(tRow, 1) = typeName
        Sheets(TargetSheet).Cells(tRow, 2) = 0
        Sheets(TargetSheet).Cells(tRow, 3) = 0
        Sheets(TargetSheet).Cells(tRow, 4) = Sheets(SourceSheet2).Cells(s2Row, 2)
        Sheets(TargetSheet).Cells(tRow, 5) = Sheets(SourceSheet2).Cells(s2Row, 3)
        tRow = tRow + 1
    'Not doing anything for the matches, because they were already added.
    End If
Next s2Row
End Sub

Finished Tested Code Results

编辑：拼写错误

使用VBA在Excel中组合两个表

1 个答案: