AW: Combobox keine Doppelten Zeilen, Sortierung
02.05.2016 19:31:46
fcs
Hallo Basti,
zum Sortieren musst du das folgende Sortiermakro in einem allgemeinen Modul des VBA-Projekts der Datei einfügen.
'Code in einem allgemeinen Modul des VBA-Projekts
Option Explicit
Public Function Quicksort(Data, links, rechts)
'Sortieren einer einspaltigen Datenliste
'links und rechts geben die Nummern der der Elemente an, die sortiert werden sollen
'normalerweise nimmt man das 1. und letzte Element
Dim Teiler As Long
If rechts > links Then
Teiler = Teile(Data, links, rechts)
Call Quicksort(Data, links, Teiler - 1)
Call Quicksort(Data, Teiler + 1, rechts)
End If
End Function
Private Function Teile(Data, links, rechts)
Dim Index As Long
Dim i As Long
Index = links
For i = links To rechts - 1
If Data(i)
Das Makro für die Auswahlliste der Combobox musst du wie folgt anpassen.
Private Sub FillComboBox()
Dim objCol As New Collection
Dim aRow As Long, i As Long, intJ As Integer, arrList()
On Error GoTo Fehler
ComboBox1.Clear
aRow = [A65536].End(xlUp).Row
objCol.Add "-", Key:="-"
For i = 2 To aRow
If Cells.Text = "" Then
objCol.Add Cells(i, 1), Key:="(blank)" 'Leerstring kann nicht Key sein!!!
Else
objCol.Add Cells(i, 1), Key:=Cells(i, 1).Text
End If
intJ = intJ + 1
ReDim Preserve arrList(1 To intJ)
arrList(intJ) = Cells(i, 1)
Next_aRow:
Next i
If intJ > 1 Then
Call Quicksort(Data:=arrList, links:=LBound(arrList), rechts:=UBound(arrList))
End If
Me.ComboBox1.List = arrList
Me.ComboBox1.AddItem "-", 0
ComboBox1.ListIndex = 0
'Fehlerbehandlung - muss am Ende des makros stehen
Fehler:
With Err
Select Case .Number
Case 0 'alles ok
Case 457 'doppelter Key-Wert in Collection
Resume Next_aRow
Case Else
MsgBox "Fehler-Nr.: " & .Number & vbLf & .Description
End Select
End With
Set objCol = Nothing
End Sub
Gruß
Franz