Liste ohne Duplikate erzeugen

Hier ein Lösungsansatz, wie man mit einem Makro, aus einer Liste mit Inhalten die auch mehrfach vorkommen können, eine Liste generiert, in der es jeden Wert nur einmal gibt. Es ist mir bekannt, das man das gleiche Ergebnis auch mit dem Spezialfilter erreichen kann. Wie das geht, beschreibe ich hier: Spezialfilter

In der Spalte A befindet sich die ungefilterte Liste, die ca. 100 Zeilen lang ist, in Spalte C das Ergebnis. Ein möglicher Einsatz wäre das Füllen von ComboBoxen oder ListBoxen in UserForms. Für solche Ansätze ist die Methode mit dem Spezialfilter sicher nicht so gut geeignet. Vor allem, wenn die Listen "leben". Das heißt, es können neue Inhalte dazukommen. Hier das Makro:

Option Explicit
Sub Liste()
' erzeugt aus dem Inhalt einer Spalte eine Liste ohne Duplikate
' geschrieben von Klaus-Dieter Oppermann

' Variablen deklarieren
Dim s As Integer
Dim t As Integer
Dim r As Integer
Dim rr As Integer
Dim we As Integer
Dim nam(100) As String
' Werte in Variablen einlesen
For s = 2 To Range("A65536").End(xlUp).Row  ' Schleifenstart, gehe von Zeile 2 bis letzte Zeile
    we = 0                                  ' Temporäre Variable auf null setzen
    For t = 2 To s                          ' Schleifenstart, gehe von Zeile 2 bis aktuelle Zelle
        If nam(t) = Cells(s, 1) Then we = 1 ' Wenn Wert aus Variable gleich aktuelle Zelle dann _
                                              temporäre Variable gleich 1
    Next t                                  ' Wendepunkt für Schleife
    If we = 0 Then nam(t) = Cells(s, 1)     ' Wenn temp. Variable gleich null dann Wert aus _
                                              aktueller Zelle in Variable
Next s                                      ' Wendepunkt für Schleife
' Werte in neuer Spalte ausgeben
For r = 1 To t                              ' Schleifenstart
    If nam(r) <> "" Then                    ' Wenn Variable einen Inhalt hat, dann ...
        rr = rr + 1                         ' ... Zähler für Zelle im Ausgabebereich plus 1
        Cells(rr, 3) = nam(r)               ' ... Variable in Zelle schreiben
    End If                                  ' Ende der Bedingung
Next r                                      ' Wendepunkt für Schleife
End Sub                                     ' Ende des Makros

Wie so oft im Leben (und auch bei Excel) können verschiedene Wege zum Ziel führen. Ein zweites Makro, etwas kürzer, aber möglicherweise schwerer verständlich:

Option Explicit
Sub liste_ohne_Duplikate()
' schreibt aus einer Liste, die nicht sortiert sein muss, alle vorkommenden
' Begriffe in eine neue Liste. Duplikate werden dabei ausgefiltert.
' Geschrieben von Klaus-Dieter Oppermann, Oktober 2005

' Variablen deklarieren
Dim iZiel As Integer                        ' Letzte gefüllte Zelle
Dim az As Integer                           ' Zähler für Arrayfelder
Dim i As Integer                            ' Schleifenzähler (Arrays füllen)
Dim arr() As Variant                        ' Array für Datenausgabe
iZiel = Range("A65536").End(xlUp).Row       ' Letzte gefüllte Zelle ermitteln (in Spalte A)
' Array dimensionieren
ReDim arr(iZiel, 0)                         ' Feld nach Listenlänge festlegen
' Arrays mit Werten füllen
For i = 2 To UBound(arr)                                                ' laufe von Zeile 2 bis Tabellenende
    If Application.WorksheetFunction.CountIf(Range(Cells(i, 1), _
    Cells(1, 1)), Cells(i, 1).Value) = 1 Then                           ' wenn Wert das erste Mal vorkommt, dann ...
        arr(az, 0) = Cells(i, 1).Value                                  ' ... Name in Array einlesen
        az = az + 1                                                     ' ... Zähler für Arrayfeld plus 1
    End If                                                              ' Ende der Auswertung
Next i                                                                  ' Schleifenzähler plus 1
' Inhalte ausgeben
Range("C2", "C" & UBound(arr)) = arr                                    ' Werte in Ausgabebereich schreiben
Columns("A:C").EntireColumn.AutoFit                                     ' Spalten auf optimale Breite
End Sub

Wenn das Makro dazu eingesetzt werden soll, die Werte in eine Combobox einzulesen, muß die vorletzte Zeile so aussehen:

ComboBox1.List = arr                                                    ' Werte in ComboBox schreiben

Die letzte Zeile:

Columns("A:C").EntireColumn.AutoFit

fällt weg.

Zum Abschluß noch eine etwas geänderte Version des zweiten Makros. Dieses kann die Liste aus einem beliebig markierten Bereich erstellen.

Option Explicit

Sub liste_ohne_Duplikate_selekt()
' schreibt aus einer Liste, die nicht sortiert sein muss, alle vorkommenden
' Begriffe in eine neue Liste. Duplikate werden dabei ausgefiltert.
' Die Liste wird über den aktuell markierten Bereich definieret.
' Geschrieben von Klaus-Dieter Oppermann, August 2007
' Variablen deklarieren
Dim iZiel As Integer                                        ' Letzte gefüllte Zelle
Dim az As Integer                                           ' Zähler für Arrayfelder
Dim arr As Variant                                          ' Array für Datenausgabe
Dim rBereich As Range                                       ' Suchbereich
Dim zelle As Range                                          ' Zelle im Suchbereich
Dim iAusgSp As Integer                                      ' Letzte Gefüllte Spalte im Bereich
Set rBereich = Selection                                    ' Bereich durch Selektieren definieren
' Arrays mit Werten füllen
ReDim arr(rBereich.Rows.Count * rBereich.Columns.Count, 0)  ' Array dimensionieren
For Each zelle In rBereich                                  ' laufe durch markierten Bereich
    If Application.WorksheetFunction.CountIf(Range _
    (rBereich.Address), zelle.Value) = 1 Then               ' wenn Wert das erste Mal vorkommt, dann ...
        arr(az, 0) = zelle.Value                            ' ... Name in Array einlesen
        az = az + 1                                         ' ... Zähler für Arrayfeld plus 1
    End If                                                  ' Ende der Auswertung
Next zelle                                                  ' nächste Zelle
' Inhalte ausgeben und sortieren
iAusgSp = Range("IV" & rBereich.Row).End(xlToLeft).Column   ' letzte Spalte finden
Range(Cells(2, iAusgSp + 2), Cells(az, iAusgSp + 2)) = arr  ' Werte in Ausgabebereich schreiben
Range(Cells(2, iAusgSp + 2), Cells(az, iAusgSp + 2)).Sort _
Key1:=Cells(2, iAusgSp + 2), Order1:=xlAscending, _
Header:=xlGuess, OrderCustom:=1, MatchCase:=False, _
Orientation:=xlTopToBottom, DataOption1:=xlSortNormal       ' Ausgabebereich sortieren
End Sub