在Excel中使用VBA合并两个表

Question

使用Excel VBA我希望能够将excel中的两个表与一个公共密钥相结合。我建议将ADODB作为一种方法，但我愿意接受任何其他更高效/优雅的方法。请参阅下面的一个小例子：

我有下面下手......

工作表Sheet1

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 

Sheet2中

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 

，并想它结合，从而我有以下结果：

Sheet3

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 

已经做了一点Google搜索和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 SourceSheet2 - 将它们设置为变量lastRow1 & lastRow2
• 为每个表的行股票。 s1Row，s2Row，tRow
• set tRow = 2对于TargetSheet的第一行
• 使用For循环遍历SourceSheet1的每一行。使用类似这样的代码
• 当代码的第一部分完成循环时，您将完成将SourceSheet1中的每个项目添加到TargetSheet中。然后，你将不得不检查SourceSheet2中的值，看看是否有唯一的列表。
• 完成后，您应该只添加最初搜索时丢失的那些。然后targetSheet将在SourceSheet1的订单的所有项目，然后从SourceSheet2额外的项目

设置变量

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 

PHASE ONE：复制从Sheet1中的每个条目到目标，而从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 

第二阶段：工作表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 

01检查SourceSheet2接受报名NOT

编辑：错字改正试过现在又增加了