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