使用VBA在Excel中组合两个表

使用Excel VBA我希望能够将excel中的两个表与一个公共密钥相结合。 我build议ADODB作为一种方法，但是可以使用其他更高效/优雅的方法。 请看下面的例子：

我有以下开始…

工作表Sheet1

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

Sheet2中

  ABC 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

  ABCDE 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 

做了一些谷歌search和SQLtypes的外部连接似乎接近，但不知道如何实现它。

以下是用于尝试和实施它的代码…

 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＆SourceSheet2的LastRow – 将它们设置为variableslastRow1＆lastRow2
• 为每个工作表创build一个行代码。 s1Row，s2Row，tRow
• 设置tRow = 2对于TargetSheet的第一行
• 使用For循环遍历SourceSheet1的每一行。 使用这样的东西
• 当代码的第一部分完成循环时，您将完成将SourceSheet1中的每个项目添加到TargetSheet中。 然后，您将不得不检查SourceSheet2中的值以查看是否有唯一的列表。
• 完成之后，您应该只添加最初search时丢失的那些。 然后，targetSheet将按照SourceSheet1所有项目的顺序，然后是SourceSheet2中的额外项目

设置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 

编辑：错字更正