Doppelte Einträge in eigene Spalte extrahieren

101073

Dieses Makro extrahiert in Spalte B alle Daten, die doppelt vorhanden sind.
Nur in Spalte A nicht doppelt vorhandene Einträge werden nicht in Spalte B geschrieben!

Public Sub Liste_doppelte()
Dim wert1(100)
Dim wert2(200)
Dim zeilen
zeilen = 17 'Anzahl der Zeilen die geprüft werden sollen
zaehler = 0

'Werte in Variablen einlesen
For i = 1 To zeilen
wert1(i) = Cells(i, 1)
wert2(i) = Cells(i, 1)
Next i

'Schleife um die Variable wert1(i) mit wert2(i) zu vergleichen
For i = 1 To zeilen
zaehler = 0
    'Schleife, um die Variable wert1(i) mit wert2(i) zu vergleichen
    For j = 1 To zeilen
        If wert1(i) = wert2(j) Then
            zaehler = zaehler + 1
            
                If zaehler > 1 Then
                    Cells(i, 2).Value = wert2(i)
                    'wert2(i) = ""
                End If
        
        End If
    Next j
Next i

End Sub

Das Ergebnis sieht dann wie folgt aus:
Nur die Werte 9, 7, 3 und 6 werden nicht in Spalte A geschrieben,
da nur diese 4 Werte keinen Doppelgänger in Spalte A haben!

	A	B
1	Daten	gefiltert
2	9
3	5	5
4	1	1
5	2	2
6	4	4
7	1	1
8	2	2
9	7
10	1	1
11	1	1
12	10
13	5	5
14	3
15	4	4
16	6
17	4	4