Sortieren nach Spaltenkopf -spezial-

.. das wohl mächtigste Werkzeug in Bill Gates' Büro-Sippe. Ob reine Formeln, PowerQuery oder VBA. Hier bleiben kaum Wünsche unerfüllt.
Benutzeravatar
d'r Bastler
Beiträge: 832
Registriert: 29. Aug 2022, 13:20
Hat sich bedankt: 224 Mal
Danksagung erhalten: 118 Mal

Sortieren nach Spaltenkopf -spezial-

#1

Beitrag von d'r Bastler »

Moin allerseits,

nahezu jede HTML-Tabelle bei Wikipedia kann es: Ein Doppel/Klick auf den Spaltenkopf und die Daten werden nach diesem sortiert. Nur in XL muss man dafür ein bisschen Aufwand betreiben, der kompliziert wird, will man auch Nullwerte einbeziehen. Hier ist das entsprechende Doppelklick-Snippet:

Code: Alles auswählen

Option Explicit
Public isBottomUp As Boolean     'für A/Descending

Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)
Dim r As Integer, c As Integer, rng As Range, cell As Range
Cancel = True                                       'deaktiviert Target
r = Cells(Rows.Count, 1).End(xlUp).Row              'letzte belegte Zeile
c = Cells(2, Columns.Count).End(xlToLeft).Column    'letzte belegte Spalte

Set rng = Range(Cells(3, 1), Cells(r, c))           'Setzt den Range über alle belegten Spalten ohne die Zeile 1 & 2

With ActiveSheet
    
    For Each cell In rng.Cells                      'ersetzt Nullwerte temporär durch -1
        If cell = "" Then cell = -1
    Next
    If Target.Row <= 2 And Target.Column <= c Then  'reagiert nur auf DBlClk in den belegten Spalten und den ZEilen 1 & 2
        With rng
                If Not isBottomUp Then              'sortiert absteigend
                    .Sort Key1:=.Range(Target.Address), Order1:=xlDescending, Header:=xlNo
                    isBottomUp = True
                Else                                'sortiert aufsteigend
                    .Sort Key1:=.Range(Target.Address), Order1:=xlAscending, Header:=xlNo
                    isBottomUp = False
                End If
        End With
    End If
    For Each cell In rng.Cells                      'er setzt die temporären -1 durch Nullwerte
        If cell = -1 Then cell = ""
    Next

End With

End Sub
Der Code gehört in die Tabelle und sollte sofort funktionieren. Lediglich die oben oder unten ausgeschlossenen Zeilen muss man ggf. anpassen. Enthält die Tabelle auch Minus-Werte, kann man die beiden For Each cell-Blöcke auskommentieren.

Viel Spaß damit! Schöne Grüße
Folgende Benutzer bedankten sich beim Autor d'r Bastler für den Beitrag:
thowe
d'r Bastler von den VBAsteleien.de
Win 10 + Office 2019 & Win11 + Office 2021 + Visio 2019 pro & macOS.X15 + Office2019pro & Android12 & XL365

Wer ist online?

Mitglieder in diesem Forum: 0 Mitglieder und 0 Gäste