Live-Forum - Die aktuellen Beiträge
Anzeige
Archiv - Navigation
1612to1616
Aktuelles Verzeichnis
Verzeichnis Index
Übersicht Verzeichnisse
Vorheriger Thread
Rückwärts Blättern
Nächster Thread
Vorwärts blättern
Anzeige
HERBERS
Excel-Forum (Archiv)
20+ Jahre Excel-Kompetenz: Von Anwendern, für Anwender
Inhaltsverzeichnis

Makro starten wenn Autofilter geändert wird

Makro starten wenn Autofilter geändert wird
07.03.2018 10:51:47
Rainer
Hallo zusammen,
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

7
Beiträge zum Forumthread
Beiträge zu diesem Forumthread

Betreff
Datum
Anwender
Anzeige
AW: Makro starten wenn Autofilter geändert wird
08.03.2018 03:25:42
Rainer
Hallo Uwe,
es hilft ein wenig. Mein Ziel ist ein eigener Event, der NUR beim benutzen von Autofiltern reagiert.
Ich bin jetzt soweit, alle Filter in ein Array zu schreiben als "Selection Change Event". Bei einem "Cahnge Event" mache ich das nochmal und vergleiche.
Leider habe ich etwas neues gelernt: Sortierung und Autofilter sind völlig verschieden. Nun bin ich am rätseln, wie ich auch die Sortierungen erfassen kann.
Gruß,
Rainer
Anzeige
AW: Makro starten wenn Autofilter geändert wird
08.03.2018 06:44:02
Rainer
Update:
Ich kann jetzt auch die Sortierung erkennen. Juhu.
Aber leider löst der Selection_Change Event erst aus, NACHDEM eine Sortierung angewendet wurde.
Bei Anwenden einen Autofilters löst er GARNICHT aus.
Alles großer Mist.
Bedingten Erfolg habe ich mit folgender Anordnung:

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.
Für weitere Ideen bin ich dankbar.
Ich habe nur eine Variante gefunden, wo man die Datei als xml speichern soll und dort ausliest. Das ist aber viel zu lang um "heimlich" im Hintergrund zu laufen.
Gruß,
Rainer
Anzeige
AW: Makro starten wenn Autofilter geändert wird
08.03.2018 07:30:51
Rainer
Eine temporäre Lösung habe ich gefunden.
Man "verstecke" die Autofilter Option für Spalten vom Typ Datum.
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.
Aber Autofilter (z.B. "2018,März") sind nun weg und der Code läuft.
Gruß,
Rainer
AW: Makro starten wenn Autofilter geändert wird
12.03.2018 10:35:05
Rainer
.Criteria1 kann leider alle möglichen Variablentypen annehmen, ich bin noch am prüfen...
Die jetztige Version klappt nur mit "String".
Anzeige
Erledigt: Makro starten wenn Autofilter geändert
14.03.2018 02:21:11
Rainer
Hallo zusammen,
hier nun der Code der JEDEN Autofilter/Sortierung (außer Datum) vergleichen kann.
Es braucht zusätzlich eine volatile Formel (Datum, Uhrzeit, Zufallszahl) im Blatt um Worksheet_Change Events auszulösen. Dieser prüft dann zuerst das Resultat von "Autofilter_Change".
Im Workbook_Open wird zum einen der Autofilter Zustand aufgenommen und die Filter für Datumsspalten abgeschaltet.
'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

Anzeige
AW: Erledigt: Makro starten wenn Autofilter geändert
14.03.2018 02:28:42
Rainer
Im letzten Beitrag fehlt der Hinweis, dass "AF1" und "SF1" als Public deklariert sein sollen.
Nachdem dieses Werk vollbracht war, fiel mit auf das es (für meinen Zweck) auch viel einfacher ging.
Man braucht dafür eine Spalte mit eindeutigen Einträgen (notfalls eben Zeilennummern).
Jede Änderung an deren Reihenfolge (z.B. durch Autofilter) wird beobachtet.
Dann geht es auch so: (Im Beispiel ist Spalte 2 die mit den eindeutigen Einträgen)

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ß,
Rainer
Anzeige

Beliebteste Forumthreads (12 Monate)

Anzeige

Beliebteste Forumthreads (12 Monate)

Anzeige
Anzeige
Anzeige