2.2k Aufrufe
Gefragt in Tabellenkalkulation von
Hallo liebe Experten,

ich habe folgendes Problem bzw. Anliegen.

Ich habe bereits zwei Tabellen über ein Makro in eine neue, übergeordnete Tabelle geladen. Das jeweils in ein eigenes Sheet.
Außerdem habe ich ein drittes Sheet erzeugen lassen, welches ich "Schnittmenge" benannt habe.

Die beiden Tabellen sind unterschiedlich aufgebaut, jedoch sind in tabelle1 in spalte A und in Tabelle 2 in Spalte T Nummern die ich vergleichen möchte.

Sprich die Spalten auf eine Schnittmenge untersuchen

Optimal ware wenn dann die Nummern die in beiden Spalten vorkommen im Sheet "Schnittmenge" aufgelistet sind.

Wäre euch sehr dankbar wenn ihr mir da helfen könntet

7 Antworten

0 Punkte
Beantwortet von beverly Experte (3.5k Punkte)
Hi,

haben die beiden Tabellen dieselbe Anzahl an Datensätzen oder unterschiedliche?

Bis später,
Karin
0 Punkte
Beantwortet von m-o Profi (22.7k Punkte)
Hallo,

hier mal ein Beispiel, wie man das lösen könnte:

Sub Schnittmenge()

Dim strBlatt1 As String
Dim strBlatt2 As String
Dim lngLetzte1 As Long
Dim lngLetzte2 As Long
Dim lngZeile1 As Long
Dim lngZeile2 As Long
Dim lngZaehler As Long
Dim i As Integer
Dim bExists As Boolean

'Bildschirmaktualisierung ausschalten:
Application.ScreenUpdating = False

'Namen der zu vergleichenden Arbeitsblätter
strBlatt1 = "Tabelle1"
strBlatt2 = "Tabelle2"

'Prüfen, ob ein Arbeitsblatt mit dem Namen Schnittmenge existiert
For i = 1 To ThisWorkbook.Worksheets.Count
If Worksheets(i).Name = "Schnittmenge" Then
bExists = True: Exit For
End If
Next i

'falls nicht, Arbeitsblatt anlegen
If bExists = False Then
'Neues Blatt wird am Ende eingefügt
Worksheets.Add After:=Worksheets(Worksheets.Count)
'Neues Blatt benennen und einrichten
ActiveSheet.Name = "Schnittmenge"
With Worksheets("Schnittmenge")
.Range("A1") = "Nummer"
.Range("B1") = "Zeilennr. in " & strBlatt1
.Range("C1") = "Zeilennr. in " & strBlatt2
With .Range("A1:C1")
.HorizontalAlignment = xlCenter
.VerticalAlignment = xlTop
.WrapText = True
End With
End With
Else
'falls das Blatt existiert, dann den Inhalt löschen
With Worksheets("Schnittmenge")
.Range(.Cells(2, 1), .Cells(.Cells(.Rows.Count, 1).End(xlUp).Row, 3)).ClearContents
End With
End If

'letzte Zeilen in den zu vergleichenden Tabellenblättern ermitteln
lngLetzte1 = Worksheets(strBlatt1).Cells(Rows.Count, 1).End(xlUp).Row
lngLetzte2 = Worksheets(strBlatt2).Cells(Rows.Count, 1).End(xlUp).Row

'Vergleich starten, Vergleich erfolgt ab Zeile 2
For lngZeile1 = 2 To lngLetzte1
For lngZeile2 = 2 To lngLetzte2
If Worksheets(strBlatt1).Cells(lngZeile1, 1).Value = Worksheets(strBlatt2).Cells(lngZeile2, 20).Value Then
'Zähler erhöhen
lngZaehler = lngZaehler + 1
With Worksheets("Schnittmenge")
.Cells(1 + lngZaehler, 1) = Worksheets(strBlatt1).Cells(lngZeile1, 1) 'Nummer
.Cells(1 + lngZaehler, 2) = lngZeile1 'gefundene Zeilennummer in Blatt 1
.Cells(1 + lngZaehler, 3) = lngZeile2 'gefundene Zeilennummer in Blatt 2
End With
End If
Next lngZeile2
Next lngZeile1

Worksheets("Schnittmenge").Activate

'Bildschirmaktualisierung einschalten:
Application.ScreenUpdating = True

MsgBox "Es wurden " & lngZaehler & " Dubletten gefunden", 64, "Vergleich abgeschlossen"

End Sub


Das Makro gehört in ein Standard-Modul deiner Tabelle.

Gruß

M.O.
0 Punkte
Beantwortet von rainberg Profi (14.9k Punkte)
Hallo,

falls dich auch eine Formellösung interessiert, dann schreibe in A1 des Arbeitsblattes "Schnittmenge" folgende Formel und ziehe sie nach Bedarf nach unten.

=WENNFEHLER(VERGLEICH(Tabelle2!T1;Tabelle1!A:A;0);"")

Hierbei erfolgt die Auflistung mit unschönen Lücken.
Wenn Du diese beseitigen willst, dann schreibe zusätzlich in B1

=INDEX(A:A;MIN(WENN(A1:A1000<>"";ZEILE(1:1000))))

und in B2

=WENNFEHLER(INDEX(A:A;VERGLEICH(1;(ZÄHLENWENN(B$1:B1;A$1:A$1000)=0)*(A$1:A$1000<>"");0));"")

Beide Formeleingaben bestätigst du mit der Tastenkombi Strg+Umschalt+Enter, da es sich um Matrixformeln handelt.
Anschließend ziehst du die Formel aus B2 nach Bedarf nach unten.
Beide Formeln sind auf 1000 Listeneinträge ausgelegt, das kannst du aber beliebig ändern.

Gruß
Rainer
0 Punkte
Beantwortet von rainberg Profi (14.9k Punkte)
Korrektur

die Formel in A1 Arbeitsblatt "Schnittmenge" muss lauten

=WENNFEHLER(INDEX(Tabelle1!A:A;VERGLEICH(Tabelle2!T1;Tabelle1!A:A;0));"")

Gruß
Rainer
0 Punkte
Beantwortet von rainberg Profi (14.9k Punkte)
Hallo nochmal,

alternativ zu meinen Formel noch ein Code mit den gleichen Ergebnissen.

Option Explicit

Sub Schnittmenge()
Dim rngC As Range, ws1 As Worksheet, ws2 As Worksheet, ws3 As Worksheet
Set ws1 = Worksheets("Tabelle1")
Set ws2 = Worksheets("Tabelle2")
Set ws3 = Worksheets("Schnittmenge")
Application.ScreenUpdating = False
For Each rngC In ws1.Range("A1:A22")
If WorksheetFunction.CountIf(ws2.Range("T:T"), rngC) Then
ws3.Range("A" & ws3.Cells(Rows.Count, 1).End(xlUp).Row + 1) = rngC
End If
Next
Application.ScreenUpdating = True
End Sub


Gruß
Rainer
0 Punkte
Beantwortet von
Vielen Dank an die ausführlichen Antworten.
Ich habe alles ausprobiert und es hat auch funktioniert. Wirklich top

einen schönen Tag euch und ein entspanntes Osterwochenende

Daniel
0 Punkte
Beantwortet von
Hallo zusammen,

wie würde der Code von rainberg aussehen, wenn man nicht die Schnittmenge, sondern die Differenz der beiden Bereiche haben möchte?

VG Laurin
...