Doppelte Werte finden und untereinander auflisten
25.09.2023 10:39:22
Chris
ich habe ca. eintausend werte in Spalte A und B stehen. Beide Spalten möchte auf doppelte Einträge vergleichen. Jeder Eintrag, der doppelt vorhanden ist, soll in Spalte C untereinander aufgelistet werden. Ich habe dazu untenstehende Makro, welches mir den letzten doppelt vorhandenen Wert in C1 ausgibt. Vielleicht hat jmd. eine Idee, was geändert werden muss. Gruß Chris
Sub FD()
Dim arrA, arrB, i As Long, oDic As Object, c As Long
arrA = Range(Cells(1, 1), Cells(Rows.Count, 1).End(xlUp))
arrB = Range(Cells(1, 2), Cells(Rows.Count, 2).End(xlUp))
Set oDic = CreateObject("scripting.dictionary")
For i = 1 To UBound(arrB)
oDic(arrB(i, 1)) = 0
Next
For i = 1 To UBound(arrA)
If oDic.exists(arrA(i, 1)) Then
c = 1
ActiveSheet.Cells(c, 3) = arrA(i, 1)
End If
c = c + 1
Next i
End Sub