Speichern und Setzen von Autofiltereinstellungen
13.07.2018 11:52:51
Autofiltereinstellungen
ich habe ein Problem beim Speichern und wieder Setzen von Autofiltereinstellungen;
ich verwende u.a. Code, welchen ich hier im Forum gefunden habe:
Sub FiltereinstellungenMerken()
Dim Wert_Filter1() As String, Wert_Filter2() As String
Dim Wert_UndOder(), Filteranzahl As Integer
Dim i As Integer, f As Object, ZeileAutoFilter As Range
With ActiveSheet
'Filtereinstellungen merken
Set ZeileAutoFilter = .Rows(1) 'bitte anpassen
Filteranzahl = .AutoFilter.Filters.Count
ReDim Preserve Wert_Filter1(Filteranzahl)
ReDim Preserve Wert_Filter2(Filteranzahl)
ReDim Preserve Wert_UndOder(Filteranzahl)
If .AutoFilterMode Then
i = 1
For Each f In .AutoFilter.Filters
With f
If .On Then
Wert_Filter1(i) = .Criteria1
Wert_UndOder(i) = .Operator
On Error Resume Next
Wert_Filter2(i) = .Criteria2
End If
End With
i = i + 1
Next
End If
'Ende Filtereinstellungen merken
'Beispielcode
On Error Resume Next
ActiveSheet.ShowAllData 'Alles anzeigen
ActiveWindow.ScrollRow = 1 'Zeile 1 anzeigen
'Beispielcode Ende
'Beispielcode durch den Code ersetzen,
'welcher die externen Daten einfügt
'Filtereinstellungen wiederherstellen
For i = 1 To Filteranzahl
If Wert_Filter1(i) = "" Then
ZeileAutoFilter.AutoFilter Field:=i
Else
If Wert_Filter2(i) = "" Then
ZeileAutoFilter.AutoFilter Field:=i, Criteria1:=Wert_Filter1(i)
Else
ZeileAutoFilter.AutoFilter Field:=i, Operator:=Wert_UndOder(i), _
Criteria1:=Wert_Filter1(i), Criteria2:=Wert_Filter2(i)
End If
End If
Next i
'Ende Filtereinstellungen wiederherstellen
End With
End Sub
Lg,
Chrisi
