gibt es eine Möglichkeit, beim Ändern einen Autofilters automatisch ein Makro zu starten?
Also kann ich im Worksheet_Change Event erkennen, dass ein Autofilter benutzt wurde?
Danke und Gruß,
Rainer
Public AF1()
Public SortColumn
Public SortType
'from https://www.mrexcel.com/forum/excel-questions/333961-capture-autofilter-state.html
'modifed by Rainer, SortColumn and SortType added
Public Function Autofilter_Monitor()
Dim w As Worksheet
Dim currentFiltRange As String
Dim col As Integer
Set w = ActiveSheet
' Capture AutoFilter settings
With w.AutoFilter
currentFiltRange = .Range.Address
With .Filters
ReDim AF1(1 To .Count, 1 To 3)
For f = 1 To .Count
With .Item(f)
If .On Then
AF1(f, 1) = .Criteria1 '!!!! Geht nicht bei Datum
If .Operator Then
AF1(f, 2) = .Operator
End If
End If
End With
Next f
End With
With .Sort.SortFields
If .Count = 1 Then 'Sort is active
SortColumn = .Item(1).Key.Column
SortType = .Item(1).Order
End If
End With
End With
End Function
Public Function Autofilter_Change() As Boolean
Dim w As Worksheet
Dim currentFiltRange As String
Dim col As Integer
Autofilter_Change = False
Set w = ActiveSheet
' Capture AutoFilter settings
With w.AutoFilter
currentFiltRange = .Range.Address
With .Filters
For f = 1 To .Count
With .Item(f)
If .On Then
If AF1(f, 1) .Criteria1 Then Autofilter_Change = True
If .Operator Then
If AF1(f, 2) .Operator Then Autofilter_Change = True
End If
End If
End With
Next f
End With
With .Sort.SortFields
If .Count = 1 Then 'Sort is active
If SortColumn .Item(1).Key.Column Then FilAutofilter_ChangeterChangeEvent = _
True
If SortType .Item(1).Order Then Autofilter_Change = True
End If
End With
End With
End Function
dies kombiniert mit dem Tipp von UweD (es braucht ein HEUTE() um ein "Calculate" sicher auszulösen) und folgendem Code funktioniert teilweise:
Private Sub Worksheet_Calculate()
If Autofilter_Change = True Then Sort_the_Sheets
Call Autofilter_Monitor
End Sub
Leider gibt mit "Criteria1" einen "Anwendungs- oder objektdefinierter Fehler" aus, wenn die Spalte mit "Datum" gefiltert wird. Die Fehlernummer ist 1004.Private Sub Workbook_Open()
'Disable Autofilters for Date columns, as they cause errors
Sheets("Overview").Range("A2:Z2").AutoFilter Field:=8, VisibleDropDown:=False
Sheets("Overview").Range("A2:Z2").AutoFilter Field:=14, VisibleDropDown:=False
End Sub
Man kann jetzt noch über die Menüleiste sortieren, das macht auch keine Probleme. 'Private Sub Workbook_Open()
'Disable Autofilters for Date columns, as they cause errors
'Sheets("Overview").Range("A2:Z2").AutoFilter Field:=8, VisibleDropDown:=False
'Sheets("Overview").Range("A2:Z2").AutoFilter Field:=14, VisibleDropDown:=False
'Call Autofilter_Monitor
Public Function Autofilter_Monitor()
On Error GoTo hell
Dim w As Worksheet
Dim currentFiltRange As String
Dim col As Integer
Set w = ActiveSheet
' Capture AutoFilter settings
With w.AutoFilter
currentFiltRange = .Range.Address
With .Filters
ReDim AF1(1 To .Count, 1 To 4)
For f = 1 To .Count
With .Item(f)
If .On Then
AF1(f, 1) = True
AF1(f, 2) = .Criteria1
If .Operator Then
AF1(f, 3) = .Operator
If .Operator = xlAnd Or .Operator = xlOr Then AF1(f, 4) = . _
Criteria2
End If
End If
End With
Next f
End With
ReDim SF1(1 To 9)
If .Sort.SortFields.Count = 1 Then
SF1(1) = .Sort.SortFields.Count
With .Sort.SortFields.Item(1)
SF1(2) = .Key.Column
SF1(3) = .SortOn
SF1(4) = .Order
SF1(5) = .DataOption
End With
With .Sort
SF1(6) = .Header
SF1(7) = .MatchCase
SF1(8) = .Orientation
SF1(9) = .SortMethod
End With
End If
End With
hell:
End Function
Public Function Autofilter_Change() As Boolean
On Error GoTo hell
If Not IsArray(AF1) Then 'On first run this will happen, or when AF1 not initialized
GoTo hell
End If
Dim w As Worksheet
Dim currentFiltRange As String
Dim col As Integer
Autofilter_Change = False
Set w = ActiveSheet
' Capture AutoFilter settings
With w.AutoFilter
currentFiltRange = .Range.Address
With .Filters
For f = 1 To .Count
With .Item(f)
If .On = True And IsEmpty(AF1(f, 2)) Then GoTo hell
If .On = False And Not IsEmpty(AF1(f, 2)) Then GoTo hell
If .On = True And Not IsEmpty(AF1(f, 2)) Then
If VarType(AF1(f, 2)) VarType(.Criteria1) Then GoTo hell
If VarType(.Criteria1) > 8000 Then
If Join(AF1(f, 2)) Join(.Criteria1) Then GoTo hell
Else
If AF1(f, 2) .Criteria1 Then GoTo hell
End If
If .Operator Then
If AF1(f, 3) .Operator Then GoTo hell
If .Operator = xlAnd Or .Operator = xlOr Then
If AF1(f, 4) .Criteria2 Then GoTo hell
End If
End If
End If
End With
Next f
End With
If .Sort.SortFields.Count SF1(1) Then GoTo hell
With .Sort.SortFields.Item(1)
If SF1(2) .Key.Column Then GoTo hell
If SF1(3) .SortOn Then GoTo hell
If SF1(4) .Order Then GoTo hell
If SF1(5) .DataOption Then GoTo hell
End With
With .Sort
If SF1(6) .Header Then GoTo hell
If SF1(7) .MatchCase Then GoTo hell
If SF1(8) .Orientation Then GoTo hell
If SF1(9) .SortMethod Then GoTo hell
End With
End With
GoTo FunctionEnd
hell:
MsgBox "Autofilter_Change = True"
FunctionEnd:
End Function
Public MyList
Public Function Autofilter_Monitor()
MyList = ""
i = 1
Do While Cells(i, 2) ""
If Rows(i).Hidden = False Then MyList = MyList & Cells(i, 2).Value
i = i + 1
Loop
End Function
Public Function Autofilter_Change() As Boolean
CheckList = ""
i = 1
Do While Cells(i, 2) ""
If Rows(i).Hidden = False Then CheckList = CheckList & Cells(i, 2).Value
i = i + 1
Loop
If CheckList MyList Then Autofilter_Change = True
End Function
Gruß,