AW: .Find hört nicht auf
27.08.2017 21:05:06
Nepumuk
Hallo Domi,
kopiere folgende Prozedur in das Modul des UserForms:
Private Sub QuickSort(ByVal pvlngLBound As Long, ByVal pvlngUBound As Long, _
ByVal pvlngColumn As Long, ByRef probjControl As MSForms.Control, _
ByVal pvenmSortValue As SORT_VALUE, ByVal pvenmSortOrder As XlSortOrder)
Dim ialngIndex1 As Long, ialngIndex2 As Long, ialngIndex3 As Long
Dim vntTemp As Variant, vntBuffer As Variant
ialngIndex1 = pvlngLBound
ialngIndex2 = pvlngUBound
With probjControl
Do
If pvenmSortOrder = xlAscending Then
Select Case pvenmSortValue
Case Sort_Text
vntTemp = .List((pvlngLBound + pvlngUBound) \ 2, pvlngColumn)
Do While .List(ialngIndex1, pvlngColumn) < vntTemp
ialngIndex1 = ialngIndex1 + 1
Loop
Do While vntTemp < .List(ialngIndex2, pvlngColumn)
ialngIndex2 = ialngIndex2 - 1
Loop
Case Sort_Numeric
vntTemp = CDbl(.List((pvlngLBound + pvlngUBound) \ 2, pvlngColumn))
Do While CDbl(.List(ialngIndex1, pvlngColumn)) < vntTemp
ialngIndex1 = ialngIndex1 + 1
Loop
Do While vntTemp < CDbl(.List(ialngIndex2, pvlngColumn))
ialngIndex2 = ialngIndex2 - 1
Loop
Case Sort_Date
vntTemp = CDate(.List((pvlngLBound + pvlngUBound) \ 2, pvlngColumn))
Do While CDate(.List(ialngIndex1, pvlngColumn)) < vntTemp
ialngIndex1 = ialngIndex1 + 1
Loop
Do While vntTemp < CDate(.List(ialngIndex2, pvlngColumn))
ialngIndex2 = ialngIndex2 - 1
Loop
End Select
Else
Select Case pvenmSortValue
Case Sort_Text
vntTemp = .List((pvlngLBound + pvlngUBound) \ 2, pvlngColumn)
Do While .List(ialngIndex1, pvlngColumn) > vntTemp
ialngIndex1 = ialngIndex1 + 1
Loop
Do While vntTemp > .List(ialngIndex2, pvlngColumn)
ialngIndex2 = ialngIndex2 - 1
Loop
Case Sort_Numeric
vntTemp = CDbl(.List((pvlngLBound + pvlngUBound) \ 2, pvlngColumn))
Do While CDbl(.List(ialngIndex1, pvlngColumn)) > vntTemp
ialngIndex1 = ialngIndex1 + 1
Loop
Do While vntTemp > CDbl(.List(ialngIndex2, pvlngColumn))
ialngIndex2 = ialngIndex2 - 1
Loop
Case Sort_Date
vntTemp = CDate(.List((pvlngLBound + pvlngUBound) \ 2, pvlngColumn))
Do While CDate(.List(ialngIndex1, pvlngColumn)) > vntTemp
ialngIndex1 = ialngIndex1 + 1
Loop
Do While vntTemp > CDate(.List(ialngIndex2, pvlngColumn))
ialngIndex2 = ialngIndex2 - 1
Loop
End Select
End If
If ialngIndex1 <= ialngIndex2 Then
For ialngIndex3 = 0 To .ColumnCount - 1
vntBuffer = .List(ialngIndex1, ialngIndex3)
.List(ialngIndex1, ialngIndex3) = .List(ialngIndex2, ialngIndex3)
.List(ialngIndex2, ialngIndex3) = vntBuffer
Next
ialngIndex1 = ialngIndex1 + 1
ialngIndex2 = ialngIndex2 - 1
End If
Loop Until ialngIndex1 > ialngIndex2
End With
If pvlngLBound < ialngIndex2 Then Call QuickSort(pvlngLBound, _
ialngIndex2, pvlngColumn, probjControl, pvenmSortValue, pvenmSortOrder)
If ialngIndex1 < pvlngUBound Then Call QuickSort(ialngIndex1, _
pvlngUBound, pvlngColumn, probjControl, pvenmSortValue, pvenmSortOrder)
End Sub
Ganz oben unter Option Explicit kommen folgende Zeilen:
Private Enum SORT_VALUE
Sort_Text
Sort_Numeric
Sort_Date
End Enum
Der Aufruf muss als letzte Zeile der Füllroutine stehen:
Call QuickSort(0, ListBox1.ListCount - 1, 0, ListBox1, Sort_Text, xlAscending)
Die erste 0 ist der kleinste Index der ListBox und darf nicht geändert werden. Die 0 an der dritten Spalte gibt an dass die erste Spalte der ListBox sortiert wird. Sort_Text gibt an dass Text sortiert wird, du kannst aber auch nach Datum (Sort_Date) oder nach Zahlen (Sort_Numeric) sortieren, je nachden was die Spalte enthält. xlAscending gibt an, dass die Liste aufsteigend sortiert wird. Willst du absteigend sortieren dann musst du da xlDescending eingeben.
Gruß
Nepumuk