Herbers Excel/VBA-Archiv

Informationen und Beispiele zum Thema MsgBox
Screenshot zu MsgBox	MsgBox-Seite mit Beispielarbeitsmappe aufrufen

Informationen und Beispiele zum Thema Label
Screenshot zu Label	Label-Seite mit Beispielarbeitsmappe aufrufen

Informationen und Beispiele zum Thema ListBox
Screenshot zu ListBox	ListBox-Seite mit Beispielarbeitsmappe aufrufen

Sortierung erweitern.

• Sortierung erweitern. von Thomas vom 30.09.2019 12:00:01
• AW: Sortierung erweitern. - von Matthias am 30.09.2019 15:12:36
• besten Dank an Matthias - von Thomas am 30.09.2019 15:38:37

Betrifft: Sortierung erweitern. von: Thomas
Geschrieben am: 30.09.2019 12:00:01

Hallo Excelfreunde,

ich möchte gern eine Listbox nach 3 Kriterien sortieren. Dazu habe ich ein Code aus einer Datei von

XLph genommen und diesen angepasst.

Dieser funktioniert jetzt auch fast so wie ich es gern haben möchte.

Klickt man über eine Spalte ( im Label ) wird diese Spalte dementsprechend sortiert. ( ein Kriterium ) Klickt man in die nächste Spalte so wird auch diese sortiert.( auch wieder ein Kriterium)

Gern würde ich umsetzen:

Klick über die z.B. Spalte = sortiere den Datensatz als Kriterium 1
Klick in die z.B. 2. Spalte = sortiere den Datensatz als Kriterium 2
Klick in die z.B. 4. Spalte = sortiere den Datensatz als Kriterium 4

Um alle Kriterien auf null zusetzen benötige ich kein Button. Da ich die Daten dann einfach wieder neu einlesen kann

Kann mir jemand behilflich bei der Umsetzung sein?

Ich bekomme das einfach nicht umgesetzt.

https://www.herber.de/bbs/user/132288.xlsm

habt schon mal rechtvielen dank für euer Interesse.

mfg thomas

Betrifft: AW: Sortierung erweitern. von: Matthias
Geschrieben am: 30.09.2019 15:12:36

Moin!
Lege mal am Anfang noch eine private Variable sortkrit an. ALso die Zeile einfügen.
Private sortkrit As String

Und dann tausche dein MousUpEvent damit.

Private Sub lblSort_MouseUp(ByVal Button As Integer, ByVal Shift As Integer, ByVal X As Single,  _
ByVal Y As Single)

    Dim astrColumnWidth() As String
    Dim iastrCW As Long
    Dim sngColumnWidth As Single
    Dim sngSum As Single
    Dim i As Long
    Dim lngFieldIndex As Long
    Dim kritliste
    Dim lngSortOrder As XlSortOrder
    
    
    'If datenberech.ListRows.Count = 0 Then Exit Sub
    
    Select Case Button
        Case 1: lngSortOrder = xlAscending
        Case 2: lngSortOrder = xlDescending
        Case Else: Exit Sub
    End Select
    
    astrColumnWidth() = Split(Replace(ListBox1.ColumnWidths, " Pt", ""), ";")
    For iastrCW = LBound(astrColumnWidth) To UBound(astrColumnWidth)
        sngColumnWidth = CSng(astrColumnWidth(iastrCW))
        sngSum = sngSum + sngColumnWidth
        If sngSum >= X Then lngFieldIndex = iastrCW: Exit For
    Next
    
'    If lngFieldIndex > 0 Then
'        With datenberech.Range
'            .Sort .Cells(1, lngFieldIndex + 1), lngSortOrder, Header:=xlYes
'        End With
'       ' Call GetFilterData(Listbox1, lblFilterCount)
'    End If
    
    
 Dim iLSpalte As Integer ' die letzte belegte Spalte in Zeile 1 'xlAscending xlDescending
Dim lLZeile As Long ' die letzte belegte Zeile in Spalte A



Dim Spaltennummer1
Dim Spaltennummer2


Spaltennummer1 = lngFieldIndex

Dim sortrichtung As Integer

'If aufsteigend = False And absteigend = False Then
'MsgBox " Achtung soll ich absteigend oder austeigend sortieren. Bitt setz den Hacken."
'Exit Sub
'End If

'If absteigend.Value = True Then
sortrichtung = lngSortOrder 'xlDescending

'Spaltennummer1 = CB_suchspalten.ListIndex + 1
'Spaltennummer2 = CB_suchspalten2.ListIndex + 1
    
 MsgBox Spaltennummer1

    With Tabelle1

lLZeile = .Cells(Rows.Count, 1).End(xlUp).Row

iLSpalte = .Cells(1, Columns.Count).End(xlToLeft).Column

sortkrit = sortkrit & ";" & Spaltennummer1 & "@" & sortrichtung

'MsgBox CB_suchspalten2.ListIndex

'If CB_suchspalten2.ListIndex = -1 Then
.Sort.SortFields.Clear
kritliste = Split(sortkrit, ";")
For i = 1 To UBound(kritliste)
Debug.Print Split(kritliste(i), "@")(0)
.Sort.SortFields.Add Key:=.Range(.Cells(2, CLng(Split(kritliste(i), "@")(0))), .Cells(lLZeile,  _
CLng(Split(kritliste(i), "@")(0)))), _
        SortOn:=xlSortOnValues, Order:=Split(kritliste(i), "@")(1), DataOption:=xlSortNormal
Next
    With .Sort
        .SetRange Tabelle1.Range(Tabelle1.Cells(1, 1), Tabelle1.Cells(lLZeile, iLSpalte))
        .Header = xlYes
        .MatchCase = False
        .Orientation = xlTopToBottom
        .SortMethod = xlPinYin
        .Apply
    End With


End With
    
End Sub

Hiermit wird die Speicherung gespeichert und neu gesetzt. Ist jett aber nicht auf 3 Durchläufe begrenzt.
VG

Betrifft: besten Dank an Matthias von: Thomas
Geschrieben am: 30.09.2019 15:38:37

Hallo Mattias,

das passt perfekt.

Ich baue dies noch heute in meine Hauptdatei ein.


Hab recht vielen vielen dank für deine Unterstützung.


mfg thomas

Beiträge aus dem Excel-Forum zum Thema "Sortierung erweitern."