Duplikate aus zwei Spalten erkennen und in eine neue Zeile schreiben

Question

Hallo alle zusammen,

ich habe eine Frage für die wahrscheinlich VBA benötigt wird und ich
deshalb überfordert bin.

Ich habe zwei Spalten mit Werten wie zum Beispiel:
Spalte 1:
ABX1231351256
ABX1252363499
ABX1353467818
ABX1534688888
ABX13591111111

Spalte 2:
ABX1231351151
ABX1252364499
ABX1352346661
ABX1534688888
ABX13591111111
ABX12523111111
ABX1352342222

Durch eine Formel/ein Makro möchte ich jetzt gerne Duplikate dieser
beiden Spalte in Spalte 3 eintragen lassen.

Optimalergebnis:
Spalte 3:
ABX1534688888
ABX13591111111

Leider handelt es sich nicht nur um wenige hundert Datensätze,
sondern bis zu 50.000 und nicht jedesmal nur um zwei Spalten, die
verglichen werden müssen, sondern teilweise bis zu fünf Spalten.

Ich habe es mit "Wenn"-Formeln und Hilfsspalten probiert, aber
schaffe leider kein zufriedenstellendes Ergebnis, das auch auf eine
solche Datenmenge übertragbar ist.

VIELEN DANK IM VORAUS!
Beste Grüße

Answer 1

Hallo,

mal eine Frage zur VBA-Lösung: Wenn es mehr als zwei Spalten gibt, wie sollen denn die Spalten verglichen werden, alle Spalten untereinander oder nur die erste Spalte mit den anderen Spalten? Und stehen die Spalten immer nebeneinander und sonst sind keine anderen Daten auf dem Blatt?

Falls du etwas mit Formeln suchst, dann schau dir mal das hier an:
Link 1
Link 2

Gruß

M.O.

Answer 2

Hi all,

auch ich habe noch zwei Fragen dazu? Kann es auch vorkommen, dass es innerhalb einer Spalte auch Dopplungen gibt? Und stehen gleiche werte immer nebeneinander?

Spontan fällt mir nur dieses Makro ein. Probier mal ob dir das was nützt. Der Durchlauf kann bei deiner Datenmenge aber eine Weile dauern.

Sub Vergleichen()

upd = 1000 'alle wieviel Zeilen soll der aktuelle Status ausgegeben werden?
'je kleiner der Wert desto langsamer das Makro

lr = ActiveCell.SpecialCells(xlLastCell).Row
lc = ActiveCell.SpecialCells(xlLastCell).Column

Application.StatusBar = "Prüfen Zeile 1 - " & upd
For Each c In Range("A1", Cells(lr, lc)).Cells
If c.Row Mod upd = 0 Then Application.StatusBar = "Prüfen Zeile " & c.Row & " - " & c.Row + upd
If (Application.CountIf(Range(c, Cells(c.Row, lc)), c.Value) > 1 _
Or Application.CountIf(Range(Cells(c.Row + 1, 1), Cells(lr, lc)), c.Value) > 0 _
And c + 1 <= lr) And _
Application.CountIf(Range(Cells(1, lc + 1), Cells(lr, lc + 1)), c.Value) = 0 Then
z = z + 1
Cells(z, lc + 1).Value = c.Value
End If
Next c
Application.StatusBar = False

Range(Cells(1, lc + 1), Cells(lr, lc + 1)).Sort Key1:=Cells(1, lc + 1), Order1:=xlAscending

MsgBox "Vergleich abgeschlossen", vbInformation

End Sub

Gruß Mr. K.