Listbox sortieren lassen

Beiträge zum Forumthread

Beiträge zu diesem Forumthread

Betreff

Datum

Anwender

Hi Horst,
die Zeile geändert, Fehler ist weg, allerdings werden die daten unsortiert eingetragen, deshalb Frae auf noch offen.

Option Explicit
Private Sub Command1_Click()
Dim Liste() As Long  'bei kommazahlen long durch double ersetzen...
Dim i As Integer
'ReDim Liste(List1.ListCount)
'For i = 0 To List1.ListCount - 1
'Liste(i + 1) = CLng(List1.List(i)) 'dann auch das clng durch ein cdbl ersetzen
'Next
ReDim Liste(3)
Liste(0) = 5
Liste(1) = 7
Liste(2) = 1
Liste(3) = 2
Quicksort 1, UBound(Liste), Liste()
ListBox1.Clear
For i = 0 To UBound(Liste)
ListBox1.AddItem Liste(i)
Next
End Sub
Private Sub Quicksort(ByVal L As Long, ByVal R As Long, ByRef mA() As Long)   'hier das letzte long ggf auch anpassen
Dim i As Integer
Dim j As Integer
Dim M  As Long 'hier auch wieder
Dim Tmp As Long 'und hier auch
If R <= L Then Exit Sub
i = L
j = R
M = mA((L + R) / 2)
Do
Do While mA(i) < M
i = i + 1
Loop
Do While mA(j) > M
j = j - 1
Loop
If i <= j Then
Tmp = mA(i)
mA(i) = mA(j)
mA(j) = Tmp
i = i + 1
j = j - 1
End If
Loop Until i > j
If L < j Then Quicksort L, j, mA()
If i < R Then Quicksort i, R, mA()
End Sub

Gruß
Reinhard
ps: Ich freue mich über eine Rückmeldung ob diese Antwort hilfreich war oder nicht..

Option Explicit Private Sub UserForm_Activate() Dim ii As Integer For ii = 0 To 10 ListBox1.AddItem Round(20 * Rnd(), 0) Next ii End Sub Private Sub CommandButton2_Click() Me.Hide End Sub Private Sub CommandButton1_Click() Dim Liste() As Long, ii As Integer ' oder Double ReDim Liste(ListBox1.ListCount) For ii = 0 To ListBox1.ListCount - 1: Liste(ii + 1) = CLng(ListBox1.List(ii)): Next ii ' oder CDbl Quicksort 1, UBound(Liste), Liste ListBox1.Clear For ii = 1 To UBound(Liste): ListBox1.AddItem Liste(ii): Next ii End Sub Private Sub Quicksort(ByVal LL As Long, ByVal RR As Long, ByRef mA() As Long) ' oder Double Dim ii As Integer, jj As Integer, M As Long, Tmp As Long ' oder Double Double If RR <= LL Then Exit Sub ii = LL: jj = RR: M = mA((LL + RR) / 2) Do Do While mA(ii) < M: ii = ii + 1: Loop Do While mA(jj) > M: jj = jj - 1: Loop If ii <= jj Then Tmp = mA(ii): mA(ii) = mA(jj): mA(jj) = Tmp ii = ii + 1: jj = jj - 1 End If Loop Until ii > jj If LL < jj Then Quicksort LL, jj, mA() If ii < RR Then Quicksort ii, RR, mA() End Sub

Beliebteste Forumthreads (12 Monate)

2
Beiträge zum Forumthread

Beiträge zu diesem Forumthread

Links zu Excel-Dialogen

Beliebteste Forumthreads (12 Monate)

Beliebteste Forumthreads (12 Monate)

Listbox sortieren lassen

2 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)

2
Beiträge zum Forumthread

Beiträge zu diesem Forumthread