| |
| In diesem Forum haben Sie die Möglichkeit Kommentare, Fragen und Verbesserungsvorschläge zu den im vb@rchiv gelisteten Tipps und Workshops zu posten.
Hinweis: Ein neues Thema kann immer nur über die jeweilige Tipps & Tricks bzw. Workshop Seite eröffnet werden! | Fragen zu Tipps & Tricks und Workshops im vb@rchivTipp 1555: ListBox-Einträge blitzschnell neu sortieren | | | Autor: PhoenixUnderFire | Tipp anzeigenDatum: 20.07.12 12:46 |
| Hallo zusammen,
der Code funktioniert wirklich Klasse und vor allem sehr schnell.
Nun habe ich eine Listbox mit 2 Spalten. Wenn ich den hier vorliegenden Code anwende, wird ja meine 2 Spalte komplett gelöscht.
Wie muss ich den Code ändern, damit das auch mit einer 2spaltigen Listbox funktioniert.
Hoffe mir kann jemand weiterhelfen.
Vielen Dank schon mal.
Viele Grüße,
Phoenix | |
Re: ListBox-Einträge blitzschnell neu sortieren | | | Autor: Manfred X | Datum: 20.07.12 21:36 |
| Hallo!
Welche VB-Version verwendest Du?
Bzw. Nutzt Du die Listbox aus MSForms 2.0 in VB6?
Wie soll sortiert werden? Nach der 1. oder der 2. Spalte? Hierarchisch?
(Der Tipp bezieht sich auf integrierte VB6-Listbox - stets einspaltig).
Für Forms 2.0
Dim entries() As String
ReDim entries(ListBox1.ListCount-1, ListBox1.ColumnCount-1)
For i = 0 To ListBox1.ListCount - 1
For k = 0 To ListBox1.ColumnCount - 1
entries(i, k) = ListBox1.List(i, k)
Next k
Next i
'Array nach einer Spalte Sortieren: Quicksort
'http://www.vbarchiv.net/tipps/details.php?id=1881
For i = 0 To ListBox1.ListCount - 1
For k = 0 To ListBox1.ColumnCount - 1
ListBox1.List(i, k) = entries(i, k)
Next k
Next i MfG
Manfred
Beitrag wurde zuletzt am 20.07.12 um 22:05:25 editiert. | |
Re: ListBox-Einträge blitzschnell neu sortieren | | | Autor: PhoenixUnderFire | Datum: 22.07.12 01:57 |
| Hallo Manfred,
zunächst einmal vielen Dank für deine schnelle Antwort.
Leider sind meine VB Kenntnisse nicht so umfanhreich, daher wollte ich dich fragen, ob der von dir angegebene Code eigenständig sein sollte oder in den im Tipp angegebenen Code eingesetzt bzw. bestimmte Passagen ersetzen sollte.
Derzeit nutze ich VB6 Version und würde gerne sowohl nach der ersten als auch nach der 2ten Spalte hierarchisch sortieren lassen, je nachdem welcher optionbutton ausgewählt wurde.
Ist das irgenwie realisierbar?
Viele Grüße
Phoenix
Beitrag wurde zuletzt am 22.07.12 um 01:57:45 editiert. | |
ListBox: Funktion für das Sortieren einer Spalte | | | Autor: Manfred X | Datum: 22.07.12 03:17 |
| 'Sortierfunktion für Spalten einer Listbox
'columindex: Spaltenindex ab 1
'columntype: Datentyp Sortierspalte 0=string, 1=Double, 2=Date
Public Sub SortListbox(ByVal lbo As Msforms.ListBox, _
ByVal columnindex As Integer, _
ByVal columntype As Integer)
Dim entries() As Variant
With ListBox1
ReDim entries(.ListCount - 1, .ColumnCount - 1)
For i = 0 To .ListCount - 1
For k = 0 To .ColumnCount - 1
entries(i, k) = .List(i, k)
Next k
Next i
Call QuickSortArray(entries, columnindex, columntype, _
0, .ListCount - 1)
For i = 0 To .ListCount - 1
For k = 0 To .ColumnCount - 1
.List(i, k) = entries(i, k)
Next k
Next i
End With
End Sub
' vSort: 2-dimensionales Array
' columnindex: Spalte, nach der sortiert werden soll (1, 2, 3, ...)
' columntype: Datentyp Sortierspalte 0=String, 1=Double, 2=Date
Public Sub QuickSortArray(vSort As Variant, _
ByVal columnindex As Integer, ByVal columntype As Integer, _
ByVal lngStart As Long, ByVal lngEnd As Long)
Dim i As Long, j As Long
Dim h As Variant, x As Variant
Dim u As Long, lb_dim As Long, ub_dim As Long
' Anzahl Elemente pro Datenzeile
lb_dim = LBound(vSort, 2)
ub_dim = UBound(vSort, 2)
i = lngStart: j = lngEnd
x = vSort((lngStart + lngEnd) / 2, columnindex - 1)
' Array aufteilen
Do
While CompareEntries(columntype, vSort(i, columnindex - 1), x) = -1
i = i + 1
Wend
While CompareEntries(columntype, vSort(j, columnindex - 1), x) = 1
j = j - 1
Wend
If (i <= j) Then
' Wertepaare miteinander tauschen
For u = lb_dim To ub_dim
h = vSort(i, u)
vSort(i, u) = vSort(j, u)
vSort(j, u) = h
Next u
i = i + 1: j = j - 1
End If
Loop Until (i > j)
If (lngStart < j) Then _
QuickSortArray vSort, columnindex, columntype, lngStart, j
If (i < lngEnd) Then _
QuickSortArray vSort, columnindex, columntype, i, lngEnd
End Sub
Public Function CompareEntries(ByVal columntype As Integer, _
ByVal e1 As Variant, ByVal e2 As Variant) As Integer
If columntype = 0 Then
If CStr(e1) > CStr(e2) Then
CompareEntries = 1
ElseIf CStr(e1) < CStr(e2) Then
CompareEntries = -1
Else
CompareEntries = 0
End If
ElseIf columntype = 1 Then
If CDbl(e1) > CDbl(e2) Then
CompareEntries = 1
ElseIf CDbl(e1) < CDbl(e2) Then
CompareEntries = -1
Else
CompareEntries = 0
End If
Else
If CDate(e1) > CDate(e2) Then
CompareEntries = 1
ElseIf CDate(e1) < CDate(e2) Then
CompareEntries = -1
Else
CompareEntries = 0
End If
End If
End Function | |
Anwendungsbeispiel | | | Autor: Manfred X | Datum: 22.07.12 03:20 |
| Um korrektes Sortieren zu gewährleisten,
muss zusätzlich zum Spaltenindex auch der
Datentyp der Spalte angegeben werden.
Private Sub Form_Load()
ListBox1.ColumnCount = 3
'Listbox mit Zufallswerten füllen (String, Double, Date)
Dim i As Integer
With ListBox1
For i = 1 To 1600
AddItems ListBox1, "A" & CStr(Round(Rnd, 4)), _
Round(100 * Rnd, 4), _
Randomdate
Next i
End With
'Sortieren (Control, Spaltenindex, Spaltentyp)
Call SortListbox(ListBox1, 1, 0)
'Call SortListbox(ListBox1, 2, 1)
'Call SortListbox(ListBox1, 3, 2)
End Sub
Private Sub AddItems(lb As Msforms.ListBox, _
Text1 As String, Text2 As String, Text3 As String)
'Hilfsfunktion Listbox füllen
lb.AddItem (Text1)
lb.List(lb.ListCount - 1, 1) = Text2
lb.List(lb.ListCount - 1, 2) = Text3
End Sub
Public Function Randomdate() As Date
'Hilfsfunktion: Zufallsdatum
Dim str As String
str = CStr(CInt(Rnd * 27) + 1) & "." & _
CStr(CInt(Rnd * 11) + 1) & ".2011"
Randomdate = CDate(str)
End Function | |
Version Zwo: Funktion für das Sortieren einer Listbox-Spalte | | | Autor: Manfred X | Datum: 22.07.12 15:41 |
| - Nutzung der Column-Eigenschaft der Listbox durch Umstellung der
Indizierung in der Sortierroutine
- Zusätzlicher Parameter für Vorgabe der Sortier-Richtung
'Sortierfunktion für Spalten einer Listbox
'columindex: Spaltenindex ab 1
'columntype: Datentyp Sortierspalte 0=String, 1=Double, 2=Date
'ascending: Sortier-Richtung
Public Sub SortListbox(ByVal lbo As Msforms.ListBox, _
ByVal columnindex As Integer, _
ByVal columntype As Integer, _
Optional ByVal ascending As Boolean = True)
Dim entries() As Variant, i As Integer, k As Integer
With ListBox1
ReDim entries(.ListCount - 1, .ColumnCount - 1)
entries = .Column
Call QuickSortArray(entries, _
columnindex, columntype, 0, .ListCount - 1, ascending)
.Column = entries
End With
End Sub
' vSort: 2-dimensionales Array
' columnindex: Spalte, nach der sortiert werden soll (1, 2, 3, ...)
' columntype: Datentyp Sortierspalte 0=String, 1=Double, 2=Date
' !!! Array-Dimensionen werden als Spalte * Zeile erwartet !!!
Public Sub QuickSortArray(vSort As Variant, _
ByVal columnindex As Integer, ByVal columntype As Integer, _
ByVal lngStart As Long, ByVal lngEnd As Long, _
Optional ByVal ascending As Boolean = True)
Dim i As Long, j As Long
Dim h As Variant, x As Variant
Dim u As Long, lb_dim As Long, ub_dim As Long
' Anzahl Elemente pro Datenzeile
lb_dim = LBound(vSort, 1)
ub_dim = UBound(vSort, 1)
i = lngStart: j = lngEnd
x = vSort(columnindex - 1, (lngStart + lngEnd) / 2)
' Array aufteilen
Do
While CompareEntries(columntype, ascending, vSort(columnindex - 1, i), x) = _
-1
i = i + 1
Wend
While CompareEntries(columntype, ascending, vSort(columnindex - 1, j), x) = _
1
j = j - 1
Wend
If (i <= j) Then
' Wertepaare miteinander tauschen
For u = lb_dim To ub_dim
h = vSort(u, i)
vSort(u, i) = vSort(u, j)
vSort(u, j) = h
Next u
i = i + 1: j = j - 1
End If
Loop Until (i > j)
If (lngStart < j) Then _
QuickSortArray vSort, columnindex, columntype, lngStart, j, ascending
If (i < lngEnd) Then _
QuickSortArray vSort, columnindex, columntype, i, lngEnd, ascending
End Sub
Public Function CompareEntries(ByVal columntype As Integer, _
ByVal ascending As Boolean, _
ByVal e1 As Variant, ByVal e2 As Variant) As Integer
Dim bigger%, lower%
If ascending Then
bigger = 1: lower = -1
Else
bigger = -1: lower = 1
End If
CompareEntries = 0
If columntype = 0 Then
If CStr(e1) > CStr(e2) Then
CompareEntries = bigger
ElseIf CStr(e1) < CStr(e2) Then
CompareEntries = lower
End If
ElseIf columntype = 1 Then
If CDbl(e1) > CDbl(e2) Then
CompareEntries = bigger
ElseIf CDbl(e1) < CDbl(e2) Then
CompareEntries = lower
End If
ElseIf columntype = 2 Then
If CDate(e1) > CDate(e2) Then
CompareEntries = bigger
ElseIf CDate(e1) < CDate(e2) Then
CompareEntries = lower
End If
Else
If e1 > e2 Then
CompareEntries = bigger
ElseIf e1 < e2 Then
CompareEntries = lower
End If
End If
End Function | |
Re: Anwendungsbeispiel | | | Autor: PhoenixUnderFire | Datum: 23.07.12 15:17 |
| Hallo Manfred,
vielen Dank für deine Mühe.
Hat mir wirklich sehr weitergeholfen und funktioniert sehr gut und vor allem sehr schnell.
Die 2.Version konnte ich bisher noch nicht testen.
Werde es aber so schnell wie möglich ausprobieren.
Viele Grüße,
Phoenix | |
Re: ListBox-Einträge blitzschnell neu sortieren | | | Autor: PhoenixUnderFire | Datum: 31.07.12 09:51 |
| Hallo Manfred,
wollte noch einmal ein Feedback geben und zwar zu deiner 2ten Version.
Funktioniert auch wieder sehr gut.
Ich habe aber noch eine Frage.
Ist es möglich, diese Listbox zu durchsuchen und nur das Suchergebnis anzuzeigen?
Der Suchbegriff würde aus einer Textbox entnommen werden...
Schon mal vielen Dank und einen schönen Tag noch.
Viele Grüße,
Phoenix | |
ListBox-Einträge filtern | | | Autor: Manfred X | Datum: 31.07.12 13:27 |
| Hallo!
Ich kenne mich mit diesem Control leider nicht aus.
Ich vermute aber, es verfügt nicht über eine derartige
eingebaute Filter-Funktion.
Ich kann deshalb nur eine Variante anbieten, bei der
die zu filternden Einträge aus der ersten in eine zweite
Listbox übernommen werden (Man könnte diese Listbox an die
Stelle der ersten setzen und nur jeweils eine der beiden Listboxen
sichtbar machen).
'lbo: Listbox mit den zu filternden Einträgem
'ColumnIndex: Spaltenindex (ab 1), in der die zu prüfenden Werte stehen
'ColumnValue: Der Wert nach dem gesucht werden soll
'Rückgabe: Array mit den gefilterten Daten
Private Function GetMatchedEntries(ByVal lbo As MsForms.ListBox, _
ByVal ColumnIndex As Integer, _
ByVal ColumnValue As Variant) As Variant()
Dim entries() As Variant
Dim matchedindices() As Integer, matchedentries() As Variant
Dim i%, k%, l%
entries = lbo.Column
ReDim matchedindices(UBound(entries, 2))
k = -1
For i = 0 To UBound(entries, 2)
If entries(ColumnIndex - 1, i) = ColumnValue Then
k = k + 1
matchedindices(k) = i
End If
Next i
If k = -1 Then
ReDim matchedentries(0, 0)
GetMatchedEntries = matchedentries
Exit Function
End If
ReDim matchedentries(UBound(entries, 1), k) As Variant
For i = 0 To k
For l = 0 To UBound(entries, 1)
matchedentries(l, i) = entries(l, matchedindices(i))
Next l
Next i
GetMatchedEntries = matchedentries
End Function
'Übertragung der Entries in eine Listbox
Private Sub SetItems(lbo As MsForms.ListBox, entries() As Variant)
Dim i%, k%
With lbo
.Clear
.ColumnCount = UBound(entries, 1)
For i = 0 To UBound(entries, 2)
.AddItem entries(0, i)
For k = 1 To UBound(entries, 1)
On Error Resume Next
.List(.ListCount - 1, k) = entries(k, i)
Next k
Next i
End With
End Sub Anwendung:
Sei Listbox1 mit Daten gefüllt, die anhand der Einträge in der ersten
Spalte gefiltert werden sollen, wobei der gesuchte Wert in der
Textbox "txtSelect" steht:
Private Sub cmdSelect_Click()
Dim matchedentries() As Variant
matchedentries = GetMatchedEntries(ListBox1, 1, txtSelect.Text)
If UBound(matchedentries, 1) > 0 Then
SetItems ListBox2, matchedentries
Else
MsgBox "nichts gefunden"
End If
End Sub
Beitrag wurde zuletzt am 31.07.12 um 13:52:16 editiert. | |
Re: Version Zwo: Funktion für das Sortieren einer Listbox-Spalte | | | Autor: PhoenixUnderFire | Datum: 20.06.13 13:45 |
| Hallo Manfred,
habe nun schon seit einiger Zeit deine ListboxSortierFunktion in Benutzung und bin voll auf begeistert.
Daher habe ich es auch bei einer anderen Aufgabenstellung erfolgreich einsetzen können.
Leider hat er Probleme wenn er z.B. Zahlen im Bereich von 0-X sortieren soll.
An erster Stelle wird nicht die 0 angezeigt sondern die 1.
Gibt es eine Möglichkeit das zu ändern?
Viele Grüße Phoenix
P.S. Hat sich erledigt...habe die falsche Spalte sortiert
Liegt wohl an der Hitze
Sorry
jetzt habe ich die Listbox noch einmal sortieren lassen.
Die Zahlen die im Bereich von 10 bis X gehen sortiert er leider nicht auf- oder absteigend.
z.B. kommt nach 1 gleich 10, 11, 12....2,20,21,....
Kann man das irgendwie verhindern?
Beitrag wurde zuletzt am 20.06.13 um 14:15:45 editiert. | |
| Sie sind nicht angemeldet! Um einen neuen Beitrag schreiben zu können, müssen Sie sich zunächst anmelden.
Einloggen | Neu registrieren |
|
|
Neu! sevCommand 4.0
Professionelle Schaltflächen im modernen Design!
Mit nur wenigen Mausklicks statten auch Sie Ihre Anwendungen ab sofort mit grafischen Schaltflächen im modernen Look & Feel aus (WinXP, Office, Vista oder auch Windows 8), inkl. große Symbolbibliothek. Weitere InfosTipp des Monats Access-Tools Vol.1
Über 400 MByte Inhalt
Mehr als 250 Access-Beispiele, 25 Add-Ins und ActiveX-Komponenten, 16 VB-Projekt inkl. Source, mehr als 320 Tipps & Tricks für Access und VB
Nur 24,95 EURWeitere Infos
|