Gruppe
Allgemein
Bereich
Vergleich
Thema
Zwei Tabellen ohne Duplikate in einer Dritten zusammenfassen
Problem
Wie kann ich zwei Tabellen ohne Berücksichtigung von doppelten Datensätzen in einer dritten Tabelle zusammenfassen?
Lösung
Geben Sie den nachfolgenden Code in ein Standardmodul ein und weisen Sie ihn einer Schaltfläche zu.
StandardModule: basMain
Sub ZusammenFuehren()
Dim wks As Worksheet
Dim rngA As Range, rngB As Range
Dim iRow As Integer, iCounter As Integer, iCol As Integer
Application.ScreenUpdating = False
Set rngA = Worksheets("Tabelle1").Range("A1").CurrentRegion
Set rngB = Worksheets("Tabelle2").Range("A1").CurrentRegion
Set wks = Worksheets("Tabelle3")
iCol = rngA.Columns.Count
If rngB.Columns.Count > iCol Then
iCol = rngB.Columns.Count
End If
For iCounter = 1 To iCol
wks.Cells(1, iCounter) = "Spalte" & iCounter
Next iCounter
wks.Rows(1).Font.Bold = True
rngA.Range("A1").CurrentRegion.Copy wks.Range("A2")
iRow = wks.Cells(Rows.Count, 1).End(xlUp).Row + 1
rngB.Range("A1").CurrentRegion.Copy wks.Cells(iRow, 1)
wks.Range("A1").CurrentRegion.AdvancedFilter Action:=xlFilterCopy, _
CopyToRange:=wks.Cells(1, wks.UsedRange.Columns.Count + 1), _
Unique:=True
wks.Range(wks.Cells(1, 1), wks.Cells(1, iCol)). _
EntireColumn.Delete
wks.Columns.AutoFit
End Sub