Herbers Excel-Forum - das Archiv
Listbox sortieren lassen
Informationen und Beispiele zu den hier genannten Dialog-Elementen:
Betrifft: Listbox sortieren lassen
von: Horst
Geschrieben am: 12.12.2006 17:50:19
Hallo!
ich habe eine ListBox mit numerischen Einträgen (3stellig).
Ich würde diese gerne sortieren lassen. Normal absteigend.
Den Code von
http://www.chip.de/c1_forum/thread.html?bwthreadid=886247
habe ich mal eingebaut.
Aber er meckert immer bei der Zeile
Quicksort 1, UBound(Liste), Liste
Die Fehlermeldung: "Unverträglicher Typ: Datenfeld oder benutzerdefinierter Typ erwartet"
Ist das bei euch auch so?
Betrifft: AW: Listbox sortieren lassen
von: Reinhard
Geschrieben am: 12.12.2006 18:21:46
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..
Betrifft: AW: Listbox sortieren lassen
von: Erich G.
Geschrieben am: 12.12.2006 18:44:57
Hallo Horst,
wie hast du Liste deklariert und mit Werten gefüllt?
So läufts problemlos:
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
Rückmeldung wäre nett! - Grüße von Erich aus Kamp-Lintfort