...

Listbox sortieren

Hier haben wir einen Datensatz mit den Namen, Berufsbezeichnungen, E-Mail-Adressen, Telefonnummern, Bonus, Land und Stunden einiger Mitarbeiter eines Unternehmens. Sie möchten diese Daten in der Listbox anzeigen, die zuerst die Spalte Stunden (aufsteigend) und dann die Spalte Namen (aufsteigend) sortiert. In diesem Artikel erfahren Sie, wie es geht.

Öffnen Sie die VBA-Umgebung

Klicken Sie auf der Registerkarte „Entwickler“ auf die Schaltfläche „Visual Basic“ oder drücken Sie ALT + F11.

Angenommen, Sie haben ein Benutzerformular namens frmSortlist mit einem Listenfeld namens ListBox1.

Fügen Sie ein neues Modul hinzu, indem Sie auf Einfügen > Modul klicken.

Sie haben jetzt ein neues Modul mit dem Namen Module1 erstellt.

Code kopieren

Kopieren Sie den folgenden Code und fügen Sie ihn in Module1 ein:

Option Explicit

Sub sortListRange()
    
    Dim sortRange As Range
    Set sortRange = Range("A1:G" & GetLastRow(shtData, "G"))
    
    With sortRange.Parent.Sort
        .SortFields.Clear
        \'first level of sorting
        .SortFields.Add _
            Key:=Range("G2:G" & GetLastRow(shtData, "G")), SortOn:=xlSortOnValues, Order:= _
            xlAscending, DataOption:=xlSortNormal
        \'second level of sorting
        .SortFields.Add _
            Key:=Range("A2:A" & GetLastRow(shtData, "A")), SortOn:=xlSortOnValues, Order:= _
            xlAscending, DataOption:=xlSortNormal
        \'you can add another sort here
            
        .SetRange sortRange
        .Header = xlYes
        .MatchCase = False
        .Orientation = xlTopToBottom
        .SortMethod = xlPinYin
        .Apply
    End With
    
    Set sortRange = Nothing
End Sub
Sub convertTimeFormat()

Dim i As Long
   
    frmSortlist.ListBox1.List = shtData.Range("A2:G" & GetLastRow(shtData, "G")).Value
    
    With frmSortlist.ListBox1
        For i = 0 To .ListCount - 1
            .List(i, 6) = Format(.List(i, 6), "hh:mm:ss")
        Next i
    End With

End Sub

\'Return the last row of the sheet based from the provided column reference
Public Function GetLastRow(mysheet As Worksheet, ReferenceColumn As Variant) As Long
    If IsNumeric(ReferenceColumn) Then
        GetLastRow = mysheet.Cells(mysheet.Rows.Count, CInt(ReferenceColumn)).End(xlUp).Row
    Else
        GetLastRow = mysheet.Range(ReferenceColumn & mysheet.Rows.Count).End(xlUp).Row
    End If
End Function

Sub showForm()

frmSortlist.Show

End Sub
Ändern Sie den markierten gelben Code mit dem Namen Ihres Datenquellenblatts und dem Bereich der Daten. Ändern Sie auch, welche Spalten zuerst, zweite usw. sortiert werden sollen.

Kopieren Sie den folgenden Code in das Benutzerformular frmSortlist:

Option Explicit

Private Sub imgSort_click()

Call loadListRange
Call sortListRange
Call convertTimeFormat

End Sub

Private Sub UserForm_initialize()
    
Call loadListRange
Call convertTimeFormat

End Sub

Private Sub loadListRange(Optional searchtext As String = "")
Dim listboxName As String: listboxName = ""         \'storing the name of the listbox.
Dim selectedColumn As String: selectedColumn = ""     \'storing the position of the columns the you wish to include in the listbox with the delimiter of comma.
Dim splitSelectedColumn() As String                 \'selectedColumn will be split and stored in this variable.
Dim columnWidth As String: columnWidth = ""         \'for column width of the listbox
Dim tblData As Variant                              \'all range data will be stored here.
Dim arrayOutput() As Variant                        \'filtered data will be stored here.
Dim arrayFinal() As Variant                         \'filtered clean data will be stored here and will be the output for listbox.
Dim i As Long: i = 0                                \'for loop iteration.
Dim X As Long: X = 0                                \'for loop iteration.
Dim outputCounter As Long                           \'number of times the loop found a match for the text in txtsearch.
Dim concatString As String

\'===================================================Developer Setting===============================================================
\'
listboxName = "ListBox1"
tblData = shtData.Range("A1:G" & GetLastRow(shtData, "G")).Value2
selectedColumn = "1,2,3,4,5,6,7"
columnWidth = "50;50;50;50;50;60;50"

\'lisboxName = [Accepts the name of the listbox in the current userform].
\'tblData = [Accepts Range.Value].
\'selectedColumn = [Accepts column position starting from 0 with the delimiter of comma].
\'columnWidth = [Accepts number or blank value that will adjust the width of each column in the listbox with the delimiter of semi colon].

\'====================================================Processing Area================================================================
splitSelectedColumn = Split(selectedColumn, ",")
ReDim arrayOutput(UBound(tblData), UBound(splitSelectedColumn)) \'Setting the size of array, based on the size of the table in excel.

\'Looping through the whole table.
For i = 1 To UBound(tblData)
    
    
    concatString = tblData(i, splitSelectedColumn(0)) & " " & tblData(i, splitSelectedColumn(1)) & " " & tblData(i, splitSelectedColumn(2)) & " "
    
    \'Finds if the current row if contains a characters types in the txtSearch.
    If InStr(LCase(concatString), LCase(searchtext)) > 0 Then
        
        \'If the row countains the characters in the txtSearch, then it is saved in the arrayOutput.
        For X = 0 To UBound(splitSelectedColumn)
            arrayOutput(outputCounter, X) = tblData(i, splitSelectedColumn(X))
        Next X
        
    \'To count how many iterations or the loop found a match for the search.
    outputCounter = outputCounter + 1
    
    End If
    
Next i

\'If the loop didnt found a match, this block of code will run.
If outputCounter = 0 Then          \'
    Erase arrayOutput              \'
    Me.Controls(listboxName).Clear \'
Exit Sub \'Stopping the current sub.\'
End If                             \'
\'\'\'\'\'\'\'\'\'\'\'\'\'\'\'\'\'\'\'\'\'\'\'\'\'\'\'\'\'\'\'\'\'\'\'\'

\'Setting the size of the second array based on the number of times the loop found a match(which is the outputCounter).
ReDim Preserve arrayFinal(outputCounter - 1, UBound(arrayOutput, 2))

\'Cleaning the arrayOutput(removing the extra rows created by the first array variable) by _
 redeclaring it in a second array variable with the size of outputCounter.
For i = 0 To outputCounter - 1               \'
    For X = 0 To UBound(splitSelectedColumn) \'
        arrayFinal(i, X) = arrayOutput(i, X) \'
    Next X                                   \'
Next                                         \'
\'\'\'\'\'\'\'\'\'\'\'\'\'\'\'\'\'\'\'\'\'\'\'\'\'\'\'\'\'\'\'\'\'\'\'\'\'\'\'\'\'\'\'\'\'\'

With Me.Controls(listboxName)
    If columnWidth <> "" Then
        .ColumnWidths = columnWidth
    End If
    .List = arrayFinal
    .Selected(0) = True
End With

Erase arrayFinal
Erase arrayOutput

DoEvents
End Sub
Ändern Sie den markierten gelben Code mit dem Namen Ihres Datenquellenblatts und dem Bereich der Daten.
Wenn Sie jetzt auf die Schaltfläche Sort Listbox klicken, wird das Makro ausgeführt, das die Daten sortiert.

 

Die Daten werden basierend auf der Sortierebene sortiert, die Sie für sortListRange() festgelegt haben.

Benötigen Sie einen VBA Programmierer?

Wir als exact construct programmieren mit einem Team von rd. 20 Mitarbeitern seit über 10 Jahren Excel-Tools. Wir sind ein Nischenanbieter der spezialisiert auf Makros/VBA-Codes ist. Daneben unterstützen wir auch als 3rd Level Support die IT-Abteilungen rund um Probleme bei MS Office (Excel, Word, PowerPoint, etc.).

Haben Sie ein Excel-Problem? Benötigen Sie einen Makro-Programmierer? Rufen Sie uns unverbindlich an +41 52 511 05 25 oder kontaktieren Sie uns via Kontaktformular.

Kommentar verfassen

Deine E-Mail-Adresse wird nicht veröffentlicht. Erforderliche Felder sind mit * markiert

Nach oben scrollen
Seraphinite AcceleratorOptimized by Seraphinite Accelerator
Turns on site high speed to be attractive for people and search engines.