Listbox mehrspaltig

Hallo liebes Forum,
ich muss eine Listbox zweispaltig und ohne Duplikate aus Tabellenblatt1 befüllen. Ich habe das Forum natürlich bereits durchsucht, aber meinen Spezialfall nicht gefunden:
Die Duplikate ergeben sich aus Spalte2 der Tabelle. Die Duplikate sollen nicht aus der Tabelle gelöscht werden. Trotzdem sollen die Spalten 1 und 2 in der Listbox stehen. In der Tabelle stehen immer unterschiedliche Dinge und auch die Zeilenzahl ist immer unterschiedlich.
Beispielsweise steht in Tabelle1:
1 Meier
1 Meier
1 Meier
1 Müller
1 Müller
2 Neumann
2 Neumann
2 Neumann
2 Schmidt
2 Schmidt
In der Listbox soll stehen:
1 Meier
1 Müller
2 Neumann
2 Schmidt
Kann mir jemand helfen? Danke sehr im voraus!

Beiträge zum Forumthread

Beiträge zu diesem Forumthread

Betreff

Datum

Anwender

Hallo Sebastian,
hier nochmal das Makro. Jetzt werden vor Befüllen der Listbox im Blatt 1 die Spalten A und B nach B alpabetisch aufsteigend sortiert. Du brauchst dich dann also nicht mehr darum zu kümmern, dass vor Befüllen der Listbox die Namen sortiert werden (falls neue dazukommen können die einfach am Ende der Namensliste dazugefügt werden).

Private Sub UserForm_Initialize()
Dim wks As Worksheet
Dim loLetzte As Long
Dim i As Long
'## festlegen des Worksheets auf dem die Liste ist ##
Set wks = ThisWorkbook.Worksheets("Tabelle1")
'## letzte belegte Zeile in Spalte B ermitteln ######
loLetzte = wks.Cells(Rows.Count, 1).End(xlUp).Row
'## Bildschirmaktualisierung aus
Application.ScreenUpdating = False
'## Spalten A und B nach Spalte B alphabetisch sortieren
Columns("B:B").Select
wks.Sort.SortFields.Clear
wks.Sort.SortFields.Add Key:=Range("B1"), _
SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal
With wks.Sort
.SetRange Range("A1:B" & loLetzte)
.Header = xlNo
.MatchCase = False
.Orientation = xlTopToBottom
.SortMethod = xlPinYin
.Apply
End With
'## Schleife von Zeile 1 bis letzter belegter Zeile #
For i = 1 To loLetzte
'## Prüfung ob aktuelle Zelle ungleich Nachfolgezelle
If wks.Cells(i, 2)  wks.Cells(i + 1, 2) Then
With Me.ListBox1
'## wenn ja Wert aus Spalte A in erste Spalte Listbox eintragen
.AddItem wks.Cells(i, 1)
'## Wert aus Spalte B in zweite Spalte Listbox eintragen
.List(.ListCount - 1, 1) = wks.Cells(i, 2)
End With
End If
Next i
'## Bildschirmaktualisierung ein
Application.ScreenUpdating = True
End Sub

Gruß Werner

Private Sub UserForm_Initialize() Dim wks As Worksheet Dim loLetzte As Long Dim i As Long '## festlegen des Worksheets auf dem die Liste ist ## Set wks = ThisWorkbook.Worksheets("Tabelle1") '## letzte belegte Zeile in Spalte B ermitteln ###### loLetzte = wks.Cells(Rows.Count, 1).End(xlUp).Row '## Bildschirmaktualisierung aus Application.ScreenUpdating = False '## Spalten A und B nach Spalte B alphabetisch sortieren With wks.Columns("B:B") wks.Sort.SortFields.Clear wks.Sort.SortFields.Add Key:=Range("B1"), _ SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal End With With wks.Sort .SetRange Range("A1:B" & loLetzte) .Header = xlNo .MatchCase = False .Orientation = xlTopToBottom .SortMethod = xlPinYin .Apply End With '## Schleife von Zeile 1 bis letzter belegter Zeile # For i = 1 To loLetzte '## Prüfung ob aktuelle Zelle ungleich Nachfolgezelle If wks.Cells(i, 2) wks.Cells(i + 1, 2) Then With Me.ListBox1 '## wenn ja Wert aus Spalte A in erste Spalte Listbox eintragen .AddItem wks.Cells(i, 1) '## Wert aus Spalte B in zweite Spalte Listbox eintragen .List(.ListCount - 1, 1) = wks.Cells(i, 2) End With End If Next i '## Bildschirmaktualisierung ein Application.ScreenUpdating = True End Sub

Beliebteste Forumthreads (12 Monate)

10
Beiträge zum Forumthread

Beiträge zu diesem Forumthread

Links zu Excel-Dialogen

Beliebteste Forumthreads (12 Monate)

Beliebteste Forumthreads (12 Monate)

Listbox mehrspaltig

10 Beiträge zum Forumthread Beiträge zu diesem Forumthread

VBA Beispiele zu verwandten Themen

Links zu Excel-Dialogen

Beliebteste Forumthreads (12 Monate)

Beliebteste Forumthreads (12 Monate)

10
Beiträge zum Forumthread

Beiträge zu diesem Forumthread