Speichern und Anwenden von Filtern mit einem Array
21.02.2018 09:30:05
Filtern
ich stehe hier vor einem Problem:
Ich habe eine Excel Liste, bei welcher sich in der Zeile 7 über die Spalten hinweg zahlreiche Filter befinden.. ca. locker >30 Stück.
Ich will ein Makro programmieren, welches nach dem Einstellen von Filtern die aktuelle (Filter)Auswahl speichert (über das Klicken einer Schaltfläche);
und ein zweites Makro, das später die alten Einstellungen der Filter wieder zurückholt und auf die Liste anwendet (ebenfalls wieder unter einer Schaltfläche)
Ich habe schon im Internet recherchiert, das ganze muss mit einem Array gemacht werden.. Leider kenn ich mich bisher in der objektorientierten Programmierung bei VBA gar nicht wirklich aus..
Im Folgenden ist mein aktueller Code, den ich aus dem Internet kopiert habe.. Die MSG Box wird natürlich nicht benötigt.. Könnt ihr mir helfen, wie ich den Code auf mein Tabellenblatt hin modifizieren muss? In sämtlichen Büchern findet man zu dem Thema praktisch keine Hilfe..
Sub Filter_Save()
Dim w As Worksheet
Dim filterArray()
Dim currentFiltRange As String
Dim col As Integer
Set w = ActiveSheet
' Capture AutoFilter settings
With w.AutoFilter
currentFiltRange = .Range.Address
With .Filters
ReDim filterArray(1 To .Count, 1 To 3)
For f = 1 To .Count
With .Item(f)
If .On Then
filterArray(f, 1) = .Criteria1
If .Operator Then
filterArray(f, 2) = .Operator
'filterArray(f, 3) = .Criteria2 'simply delete this line to make it _
work in Excel 2010
End If
End If
End With
Next f
End With
End With
MsgBox "Variante1: " & Variable1 & "" & vbNewLine & "Reihe :" & Spalte1 & ""
End Sub
und für das "Zurückholen":
Sub ReDoAutoFilter()
Dim w As Worksheet
Dim filterArray()
Dim currentFiltRange As String
Dim col As Integer
Set w = ActiveSheet
' Restore Filter settings
For col = 1 To UBound(filterArray(), 1)
If Not IsEmpty(filterArray(col, 1)) Then
If filterArray(col, 2) Then
w.Range(currentFiltRange).AutoFilter field:=col, _
Criteria1:=filterArray(col, 1), _
Operator:=filterArray(col, 2), _
Criteria2:=filterArray(col, 3)
Else
w.Range(currentFiltRange).AutoFilter field:=col, _
Criteria1:=filterArray(col, 1)
End If
End If
Next col
End Sub
Danke schonmal im Vorraus,
LG
Timo