在Excel中使用VBA组合两个表 [英] Combining two tables in Excel using VBA

问题描述

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

Using Excel VBA I would like to be able to combine two tables in excel with a common key. I have suggested ADODB as a method,but am open to any other more efficient/elegant methods. Please see below for a minimal example:

我有以下开始...

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

并且想结合它，所以我有以下结果：

And would like to combine it so that I have the following as a result:

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

做了一些谷歌搜索和SQL类型的外连接似乎很接近但不

Have done a bit of googling and SQL type outer joins seems close but not sure how to implement it.

以下是到目前为止试用和实现的代码...

Below is the code used to try and implement it so far...

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

推荐答案

根据你是否在任何一张表上都有重复的值，我可以想到一些想法，而不是使用SQL。

Depending on whether or not you have duplicate values on either sheet, I could think of a few ideas, not using SQL though.

• 获取SourceSheet1和SourceSheet2 - 将它们设置为lastRow1& lastRow2


• 为每个工作表创建行代码。 s1Row，s2Row，tRow


• set tRow = 2对于TargetSheet的第一行


• 使用For循环遍历SourceSheet1的每一行。使用这样的东西


• 当代码的第一部分循环完成后，您将完成将SourceSheet1中的每个项目添加到TargetSheet上。那么你必须检查SourceSheet2中的值，看看是否有唯一的列表。


• 完成后，你应该只添加了你初始搜索中缺少的那些。然后targetSheet将按照SourceSheet1所有项目的顺序，然后从SourceSheet2的额外项目

• Get LastRow of SourceSheet1 & SourceSheet2 - Set them as variables lastRow1 & lastRow2
• Create a row ticker for each sheet. s1Row, s2Row, tRow
• set tRow = 2 For the TargetSheet's first line
• Use For loop to cycle through each row of SourceSheet1. Using something like this
• When the first part of code is done looping, you will be finished adding every item from SourceSheet1 onto the TargetSheet. Then you will have to check the values from SourceSheet2 to see if any were unique to that list.
• When that is done, you should have only added the ones that were missing from your initial search. Then the targetSheet will be in the order of SourceSheet1 All Items, then the extra items from SourceSheet2

SET VARIABLES

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抓取匹配

PHASE ONE: Copying every entry from Sheet1 to Target, while grabbing matches from 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上的条目

PHASE TWO: Checking SourceSheet2 for Entries NOT on 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

编辑：打印错误修正

这篇关于在Excel中使用VBA组合两个表的文章就介绍到这了，希望我们推荐的答案对大家有所帮助，也希望大家多多支持IT屋！