AW: Sortieren Spalten mit Datenfilter
03.04.2007 16:40:00
fcs
Hallo Andreas.
mit folgendem Makro werden vor dem Sortieren ggf. alle Zeilen eingeblendet und nach dem Sortieren der Filter wieder auf die eingestellten Werte gesetzt.
Die Namen der Tabellen, die sortiert werden sollen muss du noch anpassen/ergänzen.
Wenn alle Tabellen sortiert werden sollen, dann geht die Schleife auch mit
For i = 1 to ActiveWorkbook.Worksheets.Count
Gruß
Franz
Sub SortierenFilter()
' Prüft auf Autofilter, Sortiert Tabelle ab Zeile 3 und setzt ggf. die Autofilter wieder
Dim wks As Worksheet, Bereich As Range, Blatt, i%
Dim Filter(), Filtergesetzt As Boolean, Filternummer%, Filterbereich As Range
'Namen der zu sortierenden Blätter im Array angeben
Blatt = Array("Basis", "Blatt2", "Blatt3")
For i = LBound(Blatt) To UBound(Blatt)
Set wks = Worksheets(Blatt(i))
With wks
Filtergesetzt = False
'Prüfen ob Datenfilter im Blatt vorhanden
If .AutoFilterMode = True Then
'Prüfen, ob Daten ausgeblendet sind
If .Cells.Count .Cells.SpecialCells(xlCellTypeVisible).Count Then
Filtergesetzt = True
'Filterdaten auslesen
ReDim Filter(1 To .AutoFilter.Filters.Count, 1 To 4)
Set Filterbereich = .AutoFilter.Range
For Filternummer = 1 To .AutoFilter.Filters.Count
If .AutoFilter.Filters(Filternummer).On = True Then
Filter(Filternummer, 1) = True 'Filter gesetzt
Filter(Filternummer, 2) = .AutoFilter.Filters(Filternummer).Criteria1
Filter(Filternummer, 3) = .AutoFilter.Filters(Filternummer).Operator
Select Case .AutoFilter.Filters(Filternummer).Operator
Case 0, xlBottom10Items, xlTop10Items, xlBottom10Percent, xlTop10Percent
Case xlAnd, xlOr
Filter(Filternummer, 4) = .AutoFilter.Filters(Filternummer).Criteria2
End Select
Else
Filter(Filternummer, 1) = False 'Filter nicht gesetzt
End If
Next Filternummer
'Ale Daten anzeigen
.ShowAllData
End If
End If
'Bereich mit Daten ab Zeile 2 ermitteln (Zeile 2 ist = Zeile mit Filterdropdownpfeilen)
Set Bereich = .Range(.Cells(2, 1), .Cells.SpecialCells(xlCellTypeLastCell))
'Bereich Sortieren
With Bereich
.Sort Key1:=.Range("A1"), Order1:=xlAscending, Key2:=.Range("B1") _
, Order2:=xlAscending, Key3:=.Range("C1"), Order3:=xlAscending, Header:= _
xlGuess, OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom
End With
'Filter wieder setzen
If Filtergesetzt = True Then
For Filternummer = 1 To .AutoFilter.Filters.Count
If Filter(Filternummer, 1) = True Then
Select Case Filter(Filternummer, 3) 'Filter Operator
Case 0, xlBottom10Items, xlTop10Items, xlBottom10Percent, xlTop10Percent
Filterbereich.AutoFilter Field:=Filternummer, Criteria1:=Filter(Filternummer, 2)
Case xlAnd, xlOr
Filterbereich.AutoFilter Field:=Filternummer, Criteria1:=Filter(Filternummer, 2), _
_
Operator:=Filter(Filternummer, 3), Criteria2:=Filter(Filternummer, 4)
End Select
End If
Next Filternummer
End If
End With
Next i
End Sub