Thomas Risi Softwareentwicklung

Sortieren einer ListBox

Diese Beispiele erläutern die Sortierung einer ListBox, die in einer UserForm enthalten ist.

Um Beispiel 1 nachvollziehen zu können, benötigen Sie also eine UF namens UserForm1 mit einer ListBox namens ListBox1. Für Beispiel 2 ist zusätzlich ein Klassenmodul erforderlich, das Sie mit clsListBox benennen. Des weiteren wird davon ausgegangen, daß sich die Daten im Bereich 'A1:A20' befinden.

Nach dem Start der UF's werden die Daten in der ListBox aufgelistet, natürlich sortiert ...

Die Klasse hat zusätzlich eine einfache Highlighting - Funktion zu bieten. Vielleicht hat ja jemand Lust, der Klasse noch etwas mehr Funktionalität zu verleihen ;-)


Beispiel 1: Code für UserForm ...
Option Explicit Private Sub UserForm_Initialize() Dim MyList() As Variant Dim MyRange As Excel.Range Dim i As Long Set MyRange = Range("A1:A20") ReDim MyList(0 To MyRange.Count - 1) For i = 0 To MyRange.Count - 1 MyList(i) = MyRange(i + 1).Value Next i ShellSort MyList ListBox1.List() = MyList End Sub ' Shellsort Sub ShellSort(ByRef data() As Variant) Dim OG&, i&, j&, k&, h As Variant OG = UBound(data) k = OG \ 2 While k > 0 For i = 0 To OG - k j = i While (j >= 0) And (data(j) > data(j + k)) h = data(j) data(j) = data(j + k) data(j + k) = h If j > k Then j = j - k Else j = 0 End If Wend Next i k = k \ 2 Wend End Sub

Beispiel 1: Code für UserForm (aber etwas kürzer) ...
Option Explicit Private Sub UserForm_Initialize() ListBox1.RowSource = "A1:A20" ShellSort ListBox1.List End Sub ' Shellsort Sub ShellSort(ByRef data As Variant) Dim OG&, i&, j&, k&, h As Variant OG = UBound(data) k = OG \ 2 While k > 0 For i = 0 To OG - k j = i While (j >= 0) And (data(j, 0) > data(j + k, 0)) h = data(j, 0) data(j, 0) = data(j + k, 0) data(j + k, 0) = h If j > k Then j = j - k Else j = 0 End If Wend Next i k = k \ 2 Wend End Sub

Beispiel 2: Code für UserForm ...
' Quellcode für UserForm. Option Explicit Dim mListBoxes(1 To 1) As New clsListBox Private Sub UserForm_Initialize() mListBoxes(1).SetListBox(Range("Tabelle1!A1:A20")) = ListBox1 End Sub ' Quellcode für das Klassenmodul. Option Explicit Dim FirstRun As Boolean Dim MyList() As Variant Dim WithEvents WS As Excel.Worksheet Dim MyRange As Excel.Range Dim WithEvents MyListBox As MSForms.ListBox Public Property Let SetListBox(List As Range, LB As MSForms.ListBox) Set MyListBox = LB Set MyRange = List Set WS = MyRange.Worksheet MyList = MyRange QuickSort MyList, 1 MyListBox.List() = MyList End Property Private Sub Class_Initialize() FirstRun = False End Sub Private Sub Class_Terminate() Set WS = Nothing Set MyRange = Nothing Set MyListBox = Nothing End Sub Private Sub MyListBox_Change() FirstRun = False QuickSort MyList, 1 End Sub ' Quicksort (IndexVersion) Sub QuickSort(data() As Variant, Optional ByVal Index, _ Optional ByVal UG, Optional ByVal OG) Dim P1&, P2&, T1 As Variant, T2 As Variant If Not FirstRun Then Index = IIf(IsMissing(Index), 1, Index) UG = IIf(IsMissing(UG), LBound(data, Index), UG) OG = IIf(IsMissing(OG), UBound(data, Index), OG) FirstRun = True End If P1 = UG P2 = OG T1 = data((P1 + P2) / 2, Index) Do Do While (data(P1, Index) < T1) P1 = P1 + 1 Loop Do While (data(P2, Index) > T1) P2 = P2 - 1 Loop If P1 <= P2 Then T2 = data(P1, Index) data(P1, Index) = data(P2, Index) data(P2, Index) = T2 P1 = P1 + 1 P2 = P2 - 1 End If Loop Until (P1 > P2) If UG < P2 Then QuickSort data, Index, UG, P2 If P1 < OG Then QuickSort data, Index, P1, OG End Sub Private Sub MyListBox_Click() Dim i As Range For Each i In MyRange If i.Value = MyListBox.Value Then i.Interior.ColorIndex = 4 Next i End Sub Private Sub MyListBox_MouseUp(ByVal Button As Integer, _ ByVal Shift As Integer, ByVal X As Single, ByVal Y As Single) MyRange.Interior.ColorIndex = 0 End Sub Private Sub WS_Change(ByVal Target As Range) MyList = MyRange FirstRun = False QuickSort MyList, 1 MyListBox.List() = MyList End Sub

Bewerten Sie bitte dieses Programm.
1 2 3 4 5
Weniger nützlich Sehr nützlich
Bitte teilen Sie uns mit, warum Sie das Programm so bewertet haben. (optional)