HERBERS Excel-Forum - das Archiv
Bewerten Sie hier bitte das Excel-Portal
Unterschiedliche Einträge herausfiltern+auflisten
Tommi

Liebe Excel-Gemeinde,
ich habe eine Tabelle mit einer Spalte A, in der in jeder Zelle verschiedene Einträge mit Komma getrennt stehen (z.B. A1: Hund, Katze, Maus; A2: Kuh, Vogel, Hamster; etc.). Kann man diese Spalte auslesen, sodass an anderer Stelle sämtliche unterschiedlichen Einträge, obwohl sie mehrfach und an verschiedenen Positionen innerhalb der Ausgangszellen vorkommen, in einer Liste untereinander stehen (jeder Eintrag eine Zelle; z.B. B1: Hund, B2: Katze, B3: Maus, B4: Hamster, B5: Vogel)? Ich habe bereits versucht, durch verschiedene Themen im Forum das Problem auf einem Umweg zu lösen (z.B. über Text in Spalten), bin aber leider der Lösung nicht näher gekommen.
Herzlichen Dank für Eure Hilfe und schöne Grüße
Tommi

Auflistung
Backowe

Hallo Tommi,
so funktioniert es.
VBA-Code:
Sub Auflistung()
Dim Zelle As Range
Dim i As Long, j As Long
Dim Ergebnis As Variant
i = 1
For Each Zelle In Range("A1:A" & Cells(Rows.Count, 1).End(xlUp).Row)
  Ergebnis = Split(Zelle, ",")
  For j = 0 To UBound(Ergebnis)
    Cells(i, 2) = Trim(Ergebnis(j))
    i = i + 1
  Next
Next
End Sub

AW: Unterschiedliche Einträge herausfiltern+auflisten
UweD

Hallo Tommi
diess Makro dürfte dein Problem lösen..


Option Explicit
Sub HundKatzeMaus()
    On Error GoTo Fehler
    Dim SP%, ZE&, LR1&, LR2&, TB1, TB2, i&, j%, A
    Set TB1 = Sheets("Tabelle1")
    Set TB2 = Sheets("Tabelle2")
    SP = 1 'Spalte A
    ZE = 1 'Zeile 1
    LR1 = TB1.Cells(Rows.Count, SP).End(xlUp).Row 'letzte Zeile der Spalte
    Application.ScreenUpdating = False
    For i = ZE To LR1
        A = Split(TB1.Cells(i, SP), ", ")
        For j = 0 To UBound(A)
            If WorksheetFunction.CountIf(TB2.Columns(SP), A(j)) = 0 Then 'noch nicht enthalten
                LR2 = TB2.Cells(Rows.Count, SP).End(xlUp).Row + 1
                TB2.Cells(LR2, SP) = A(j)
            End If
        Next j
    Next i
Fehler:
    If Err.Number <> 0 Then MsgBox "Fehler: " & Err.Number & vbLf & Err.Description: Err.Clear
End Sub


Gruß UweD

Funktioniert wunderbar
Tommi

Hallo Uwe und Backowe,
herzlichen Dank für Eure Makros. Ich habe sie auf Buttons gelegt und weidlich ausprobiert. Bei Deinem Makro, lieber Backowe, werden alle Einträge ausgelesen, erscheinen aber mehrfach in der Liste. Das habe ich jedoch sicherlich unzulänglich beschrieben. Bei Deinem Makro, lieber Uwe, werden die Einträge ausgelesen und erscheinen auch nicht mehrfach. Das ist wirklich super.
Herzlichen Dank noch einmal für Eure Hilfe.
Tommi