Kombinieren von zwei Tabellen in Excel mit VBA

Mithilfe von Excel VBA ich möchte in der Lage sein, zum kombinieren von zwei Tabellen in excel, die mit einem gemeinsamen Schlüssel. Ich habe vorgeschlagen, ADODB als eine Methode,bin aber offen für jede andere effizientere/elegante Methoden. Bitte siehe unten für ein minimal-Beispiel:

Habe ich die unten zu beginnen mit...

Tabelle1

    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

Tabelle2

    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

Möchte und kombinieren es so, dass ich habe Folgendes als Ergebnis:

Tabelle3

    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

Getan haben, ein bisschen googeln und SQL-outer-joins scheint nah, aber nicht wissen, wie es zu implementieren.

Unten ist der code, der verwendet wird, um zu versuchen und zu implementieren, ist es so weit...

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

Code versucht nun Hinzugefügt...
schön! nun, das ist eine bessere Frage.
sagen Sie was - full outer join ist nicht unterstützt durch ADODB in VBA-ich denke, also, warum nicht Sie einen Blick in HIER und vielleicht können Sie kommen mit einer Lösung für sich?
Auch alternativen
superuser.com/questions/537339/... die Ihnen helfen könnten.

InformationsquelleAutor h.l.m | 2014-10-31

Je nachdem, ob oder nicht haben Sie doppelte Werte, die entweder auf Platte, die ich mir vorstellen könnte ein paar Ideen, nicht mit SQL aber.

Bekommen LastRow von SourceSheet1 & SourceSheet2 - Setzen Sie als Variablen lastRow1 & lastRow2
Eine Zeile erstellen-ticker für jedes Blatt. s1Row, s2Row, tRow
set tRow = 2 Für die TargetSheet die erste Zeile
Verwenden Sie die For-Schleife durchläuft jede Zeile des SourceSheet1. Mit so etwas wie diesem
Wenn der erste Teil des Codes erfolgt looping, werden Sie nach dem hinzufügen jedes Element aus SourceSheet1 auf die TargetSheet. Dann haben Sie zu prüfen, die Werte von SourceSheet2 um zu sehen, ob alle waren einzigartig in dieser Liste.
Wenn das geschehen ist, Sie sollten nur Hinzugefügt werden, diejenigen, die fehlten, von der ersten Suche. Dann die targetSheet werden in der Reihenfolge der SourceSheet1 Alle Elemente, dann die zusätzlichen Elemente aus SourceSheet2

VARIABLEN FESTLEGEN

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: Kopieren Sie jeden Eintrag aus Tabelle1, um den Gegner, während grabbing Spiele von Tabelle2

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

PHASE ZWEI: Prüfung SourceSheet2 für Einträge, die NICHT auf 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