PDA

Vollständige Version anzeigen : Listenfeld sortieren


uwek
15.07.2012, 00:04
Hallo,

aus einer umfangreichen Tabelle lese ich mittels Suchbegiff Treffer in ein Listenfeld.

Private Sub cmdSearch_Click()
Dim c As Range
Dim l As Long, lngLetzte As Long
Dim SearchIn As String, sBegriff As String

On Error GoTo Err_Error
Application.ScreenUpdating = False
lstSearch.Clear
sBegriff = txtSearch.Text

If Len(sBegriff) = 0 Then Exit Sub

sBegriff = StrConv(sBegriff, vbProperCase)
lngLetzte = ErsteFreie(Sh) - 1

lblTreffer.Caption = ""
l = 0

If optNach.Value = True Then
SearchIn = "B2:B" & lngLetzte

ElseIf optVor.Value = True Then
SearchIn = "C2:C" & lngLetzte
Else
SearchIn = "A2:A" & lngLetzte
End If


For Each c In Sh.Range(SearchIn)
If c.Value Like "" & CStr(sBegriff) & "*" Then
lstSearch.AddItem
lstSearch.List(l, 0) = c.Row
If optNach.Value = True Then
lstSearch.List(l, 1) = c.Value
lstSearch.List(l, 2) = c.Offset(0, 1)
lstSearch.List(l, 3) = c.Offset(0, -1)
ElseIf optVor.Value = True Then
lstSearch.List(l, 1) = c.Offset(0, -1)
lstSearch.List(l, 2) = c.Value
lstSearch.List(l, 3) = c.Offset(0, -2)
Else
lstSearch.List(l, 1) = c.Offset(0, 1)
lstSearch.List(l, 2) = c.Offset(0, 2)
lstSearch.List(l, 3) = c.Value
End If
l = l + 1
End If
Next
lblTreffer.Caption = "Treffer: " & lstSearch.ListCount

Err_Res:
On Error Resume Next
Application.ScreenUpdating = True
On Error GoTo 0
Exit Sub

Err_Error:
MsgBox "Error " & Err.Number & " (" & Err.Description & ") in procedure cmdSearch_Click of Formular frmSearch in Zeile: " & Erl
Resume Err_Res

End Sub


wie könnte ich die Werte im Listenfeld sortiert darstellen?

EarlFred
15.07.2012, 06:19
Hallo Uwe,

Du könntest die Daten nach dem Befüllen aus dem Listenfeld in ein Array einlesen, dieses sortieren und dann dem Listenfeld wieder zuweisen:

Pseudocode:

vntToSort = lstSearch.List
sortiere vntToSort
lstSearch.List = vntToSort

Ein Sortieralgorithmus für mehrdimensionale Arrays ist z. B. hier zu finden:
Nepumuks Code bei Online-Excel (http://www.online-excel.de/excel/singsel_vba.php?f=97)

Grüße
EarlFred

uwek
16.07.2012, 20:53
Danke für die Info ;)