Beide Richtungen Sortieren

Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean) Application.ScreenUpdating = False Application.EnableEvents = False Application.Calculation = xlCalculationManual Dim Bereich1 As Range Dim LSpalte As Integer Dim LZeile As Long Dim SelectHeadline As Variant LSpalte = ActiveSheet.UsedRange.SpecialCells(xlCellTypeLastCell).Column LZeile = ActiveSheet.UsedRange.SpecialCells(xlCellTypeLastCell).Row Set Bereich1 = Range(Cells(1, 1), Cells(1, LSpalte)) If Intersect(Target, Bereich1) Is Nothing Then Exit Sub Else: SelectHeadline = ActiveCell.Address(RowAbsolute:=False, columnAbsolute:=False) Range(Cells(1, 1), Cells(LZeile, LSpalte)).Sort Key1:=Range(SelectHeadline), Order1:=xlAscending, Header:= _ xlGuess, OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom, _ DataOption1:=xlSortNormal End If Application.Calculation = xlCalculationAutomatic Application.EnableEvents = True Application.ScreenUpdating = True Range("B2").Select End Sub

Beiträge zum Forumthread

Beiträge zu diesem Forumthread

Betreff

Datum

Anwender

Dim my_sort As Boolean Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean) Application.ScreenUpdating = False Application.EnableEvents = False Application.Calculation = xlCalculationManual Dim Bereich1 As Range Dim LSpalte As Integer Dim LZeile As Long Dim SelectHeadline As Variant LSpalte = ActiveSheet.UsedRange.SpecialCells(xlCellTypeLastCell).Column LZeile = ActiveSheet.UsedRange.SpecialCells(xlCellTypeLastCell).Row Set Bereich1 = Range(Cells(1, 1), Cells(1, LSpalte)) If Intersect(Target, Bereich1) Is Nothing Then Exit Sub Else If my_sort Then SelectHeadline = ActiveCell.Address(RowAbsolute:=False, columnAbsolute:=False) Range(Cells(1, 1), Cells(LZeile, LSpalte)).sort Key1:=Range(SelectHeadline), Order1:=xlAscending, Header:= _ xlGuess, OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom, _ DataOption1:=xlSortNormal my_sort = False Else SelectHeadline = ActiveCell.Address(RowAbsolute:=False, columnAbsolute:=False) Range(Cells(1, 1), Cells(LZeile, LSpalte)).sort Key1:=Range(SelectHeadline), Order1:=xlDescending, Header:= _ xlGuess, OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom, _ DataOption1:=xlSortNormal my_sort = True End If End If Application.Calculation = xlCalculationAutomatic Application.EnableEvents = True Application.ScreenUpdating = True Range("B2").Select End Sub

Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean) Application.ScreenUpdating = False Application.EnableEvents = False Application.Calculation = xlCalculationManual Dim Bereich1 As Range Dim LSpalte As Integer Dim LZeile As Long Dim SelectHeadline As Variant LSpalte = ActiveSheet.UsedRange.SpecialCells(xlCellTypeLastCell).Column LZeile = ActiveSheet.UsedRange.SpecialCells(xlCellTypeLastCell).Row Set Bereich1 = Range(Cells(1, 1), Cells(1, LSpalte)) If Intersect(Target, Bereich1) Is Nothing Then Exit Sub Else SelectHeadline = ActiveCell.Address(RowAbsolute:=False, ClumnAbsolute:=False) Range(Cells(1, 1), Cells(LZeile, LSpalte)).Sort Key1:=Range(SelectHeadline), _ Order1:=IIf(my_sort, xlAscending, xlDescending), Header:=xlGuess, OrderCustom:=1, _ MatchCase:=False, Orientation:=xlTopToBottom, DataOption1:=xlSortNormal my_sort = Not my_sort End If Application.Calculation = xlCalculationAutomatic Application.EnableEvents = True Application.ScreenUpdating = True Range(SelectHeadline).Offset(1, 0).Select End Sub

... und Freitag ist Klugscheissertag :-) (auf mich bezogen, selbstverständlich)
Hallo zusammen,
wenn es darum geht, noch schöner, kürzer und weil es Oraculix darum geht, neues zu entdecken:
(Alles nur Vorschlag. Ist eh meistens Geschmacksache. Ausser Exit Sub: Fehler)
_ Variablendeklaration unmittelbar nach der Sub/Function-Titel ist standard. Es ist eine VBA-Krankheit, "Dim" überall zu erlauben
_ es handelt sich um eine Ereignis-Procedure, also es kann nur eine ActiveSheet geben. "Me" verwenden oder weglassen.
_ Lieber Objekt-Variablen verwenden als Werte-Variablen
Version Wert-Variablen


Dim LSpalte As Integer
Dim LZeile As Long 'warum ein Long und ein Int?
LSpalte = ActiveSheet.UsedRange.SpecialCells(xlCellTypeLastCell).Column
LZeile = ActiveSheet.UsedRange.SpecialCells(xlCellTypeLastCell).Row
Range(Cells(1, 1), Cells(LZeile, LSpalte)).Sort

Version Objekt-Variable


Dim LZelle As Range
Set LZelle = Me.UsedRange.SpecialCells(xlCellTypeLastCell)
Range(Cells(1, 1), LZelle).Sort

_ Ein Intersect kann mehr als 2 Argumente annehmen. Die Deklaration von Bereich1 ist überflüssig, weil zu nichts anderes verwendet


If Not Intersect(Target, Me.UsedRange, Me.Rows(1)) Is Nothing Then

_ SelectHeadline ist nicht anderes als Target


Target.Offset(1, 0).Select

_ der Exit Sub darf nicht sein: es werden Einstellungen vorgenommen, die IMMER zurückgenommen werden sollen:


Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)
Dim LZelle As Range
Application.ScreenUpdating = False
Application.EnableEvents = False
Application.Calculation = xlCalculationManual
Set LZelle = Me.UsedRange.SpecialCells(xlCellTypeLastCell)
If Not Intersect(Target, Me.UsedRange, Me.Rows(1)) Is Nothing Then
Range(Cells(1, 1), LZelle).Sort _
Key1:=Range(SelectHeadline), _
Order1:=IIf(my_sort, xlAscending, xlDescending), _
Header:=xlGuess, OrderCustom:=1, MatchCase:=False, _
Orientation:=xlTopToBottom, DataOption1:=xlSortNormal
my_sort = Not my_sort
Target.Offset(1, 0).Select
End If
Application.Calculation = xlCalculationAutomatic
Application.EnableEvents = True
Application.ScreenUpdating = True
End Sub

Forum.KlugscheisserModus = False
An allen ein schönen Freitag und verlängerte Wochenende
VG
Yal

Beliebteste Forumthreads (12 Monate)

11 Beiträge zum Forumthread Beiträge zu diesem Forumthread

VBA Beispiele zu verwandten Themen

Beliebteste Forumthreads (12 Monate)

Beliebteste Forumthreads (12 Monate)

11
Beiträge zum Forumthread

Beiträge zu diesem Forumthread