Live-Forum - Die aktuellen Beiträge
Anzeige
Archiv - Navigation
1200to1204
Aktuelles Verzeichnis
Verzeichnis Index
Übersicht Verzeichnisse
Vorheriger Thread
Rückwärts Blättern
Nächster Thread
Vorwärts blättern
Anzeige
HERBERS
Excel-Forum (Archiv)
20+ Jahre Excel-Kompetenz: Von Anwendern, für Anwender
Sortieren in einer mehrspaltigen Listbox
kle
Hi, ich nutze den unten stehenden Code zur Befüllung einer Listbox.
Dazu wird ein Suchtext aus einer Textbox in einem Datenbereich gesucht und dann, wenn gefunden mehrere Spalten weider zurückgegeben.
Ich würde gern die Ausgabe dann nach der 2'ten Spalte sortieren lassen - geht das ?!?
Und wenn - wie ?
Fand kein Befehl für Sort...
Gruß udn Danke
Kay
Private Sub Datensatzsuche2()
Dim sText As String
Dim ArrayData
sText = objTBSuche.Text
With objLBDaten
.ListFillRange = ""
.ColumnCount = 5
.ColumnWidths = "0;75;75;75;200"
.Clear
ArrayData = fncListe(sText)
If IsArray(ArrayData) Then
.List = fncListe(sText)
arrKontakte = arrListe
.Height = 387
.Width = 435
.Top = 101.25
.Left = 712.5
Else
.Clear
End If
End With
End Sub
Function fncListe(Optional sText As String)
Dim oDaten1, oDaten2, oDaten3, oDaten4 As Object
Dim arrListe, NewArray()
Dim A As Long
With Worksheets("Daten")
A = .Cells(.Rows.Count, 1).End(xlUp).Row
End With
If A = 1 Then
fncListe = arrListe
Exit Function
Else
Set oDaten1 = CreateObject("Scripting.dictionary")
Set oDaten2 = CreateObject("Scripting.dictionary")
Set oDaten3 = CreateObject("Scripting.dictionary")
Set oDaten4 = CreateObject("Scripting.dictionary")
arrListe = Worksheets("Daten").Range("A8:AV" & A)
For A = 1 To UBound(arrListe)
If InStr(LCase(arrListe(A, 48)), LCase(sText)) > 0 Then
oDaten1(arrListe(A, 1)) = arrListe(A, 5)
oDaten2(arrListe(A, 1)) = arrListe(A, 6)
oDaten3(arrListe(A, 1)) = arrListe(A, 9)
oDaten4(arrListe(A, 1)) = arrListe(A, 14)
End If
Next
If oDaten1.Count > 0 Then
arrListe = oDaten1.keys
ReDim NewArray(UBound(arrListe), 4)
For A = LBound(arrListe) To UBound(arrListe)
NewArray(A, 0) = arrListe(A)
NewArray(A, 1) = oDaten1(arrListe(A))
NewArray(A, 2) = oDaten2(arrListe(A))
NewArray(A, 3) = oDaten3(arrListe(A))
NewArray(A, 4) = oDaten4(arrListe(A))
Next
fncListe = NewArray
End If
End If
End Function

5
Beiträge zum Forumthread
Beiträge zu diesem Forumthread

Betreff
Benutzer
Anzeige
AW: Sortieren in einer mehrspaltigen Listbox
23.02.2011 10:25:27
Martin
Hallo Kay,
das Sortieren einer ListBox geht in drei Schritten:
1. Listbox an ein Array übergeben
    'Listbox an Array übergeben
Dim Arr()
ReDim Arr(1 To ListBox1.ListCount, 1 To ListBox1.ColumnCount)
For i = 1 To ListBox1.ListCount
For j = 1 To 9
Arr(i, j) = ListBox1.List(i - 1, j - 1)
Next j
Next i
2. Array Sortieren (suche mal nach "prcSort")
    Dim ArrK()
ArrK = Array(2)
'Sortieren
Call prcSort(ArrK, Arr)
3. Array wieder an Listbox zurückgeben
ListBox1.List() = Arr
Viele Grüße
Martin
Anzeige
AW: noch eine Frage dazu...
23.02.2011 10:31:54
kle
Vielen Dank !
Du rufst prcSort auf - wie lautet diese Funktion?
Gruß
Kay
AW: noch eine Frage dazu...
23.02.2011 10:53:53
Martin
Hallo Kay,
ich habe noch einen kleinen Fehler in meinem Code, weil "meine" Listbox genau 9 Spalten enthält und ich die Spaltenanzahl in dem Code für dich nur in der Dimensionieren des Arrays dynamisch anpasse, aber nicht beim Übertragen der Daten. Es sollte also heißen:

Dim i as Long, j as Long, Arr()
ReDim Arr(1 To ListBox1.ListCount, 1 To ListBox1.ColumnCount)
For i = 1 To ListBox1.ColumnCount
For j = 1 To 9
Arr(i, j) = ListBox1.List(i - 1, j - 1)
Next j
Next i

Der Code von prcSort (auch wenn Bertram Recht hat):
'Quicksort mit mehreren Sortierkriterien
'  Parameter:  arrK = Sortkey(s)
'              arrD = zu sortierendes Array
'  Ist die Zahl positiv, wird aufsteigend, sonst absteigend sortiert.
Public Sub prcSort(ArrK As Variant, arrD() As Variant)
Dim iiK As Integer, nnB As Long, nnC As Long, nArrZ() As Long
Dim nnZ As Long, nnA As Long, vntTemp As Variant
ReDim nArrZ(0 To 1, 0 To UBound(arrD) * 2)
nArrZ(0, 0) = LBound(arrD)                ' Array für den 1. Sortierlauf
nArrZ(0, 1) = UBound(arrD)
nnZ = 1
For iiK = LBound(ArrK) To UBound(ArrK)
If ArrK(iiK)  0 Then                 ' Wenn eine Spalte angegeben
nnA = -1
For nnB = 0 To nnZ Step 2           ' Schleife zum sortieren der Bereiche
If nArrZ(0, nnB)  nArrZ(0, nnB + 1) Then   ' Sortieren, wenn Zeilenzahl > 1
Call prcQSort(CLng(nArrZ(0, nnB)), _
CLng(nArrZ(0, nnB + 1)), CInt(Abs(ArrK(iiK))), _
CBool(ArrK(iiK) > 0), arrD())
nnA = nnA + 2                       ' sortierten Bereich merken
nArrZ(1, nnA - 1) = nArrZ(0, nnB)
nArrZ(1, nnA) = nArrZ(0, nnB + 1)
End If
Next
nnZ = -1
For nnB = 0 To nnA Step 2  'Durchsuchen der sortierten Spalte nach Wertewechsel
vntTemp = arrD(nArrZ(1, nnB), Abs(ArrK(iiK))) '1. Zeile des zu sort. Bereichs
nnZ = nnZ + 1
nArrZ(0, nnZ) = nArrZ(1, nnB)
For nnC = nArrZ(1, nnB) To nArrZ(1, nnB + 1)  ' Suche nach Wechsel im Bereich
If vntTemp  arrD(nnC, Abs(ArrK(iiK))) Then
nnZ = nnZ + 2
nArrZ(0, nnZ - 1) = nnC - 1
nArrZ(0, nnZ) = nnC
vntTemp = arrD(nnC, Abs(ArrK(iiK)))
End If
Next
nnZ = nnZ + 1                                 ' letzte Zeile im Bereich
nArrZ(0, nnZ) = nArrZ(1, nnB + 1)
Next nnB
End If
Next iiK
End Sub
Private Sub prcQSort(lngLB As Long, lngUB As Long, iiZ As Integer, _
bAufAb As Boolean, arrD())
Dim iiK As Integer, nnB As Long, nnC As Long, vntTemp As Variant, vntBuffer As Variant
nnB = lngLB
nnC = lngUB
vntBuffer = arrD((lngLB + lngUB) \ 2, iiZ)
Do
If bAufAb Then
Do While arrD(nnB, iiZ)  vntBuffer: nnB = nnB + 1: Loop
Do While vntBuffer > arrD(nnC, iiZ): nnC = nnC - 1: Loop
End If
If nnB  arrD(nnC, iiZ) Then
For iiK = LBound(arrD, 2) To UBound(arrD, 2)
vntTemp = arrD(nnB, iiK)
arrD(nnB, iiK) = arrD(nnC, iiK)
arrD(nnC, iiK) = vntTemp
Next
End If
nnB = nnB + 1
nnC = nnC - 1
ElseIf nnB = nnC Then
nnB = nnB + 1
nnC = nnC - 1
End If
Loop Until nnB > nnC
If lngLB 
Viele Grüße
Martin
Anzeige
Klappt super - Danke !
23.02.2011 12:17:04
kle
Super vielen Dank !!!
Habe es etwas angepasst und bei mir eingebaut - läuft super ;o)
Gruß und Danke
Kay

299 Forumthreads zu ähnlichen Themen

Anzeige
Anzeige
Anzeige

Links zu Excel-Dialogen

Beliebteste Forumthreads (12 Monate)

Anzeige

Beliebteste Forumthreads (12 Monate)

Anzeige
Anzeige
Anzeige