Excel Filter

[Excel_User*12]

Liebe Excel- Gemeinde,

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 über eine 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 nicht gut genug aus..




 Mir wurde schon von einer Person ein Vorschlag gemacht, leider hat der Code nicht funktioniert: 
Der Vorschlag basiert auf dem Anlegen eines zusätzlichen Blattes für die Speicherung des Arrays..
 

Sub Filter_Save()


    Dim w As Worksheet
    Dim filterArray()
    Dim currentFiltRange As String
    Dim col As Integer
    Dim f As Integer
    Dim Anz As Integer
    Set w = ActiveSheet
 
    ' Capture AutoFilter settings
    If ActiveSheet.AutoFilterMode Then 'Ist überhaupt ein Filter gesetzt?
        With w.AutoFilter
            currentFiltRange = .Range.Address
            With .Filters
                Anz = .Count 'Anzahl der Filter
                Redim filterArray(1 To Anz, 1 To 3)
                For f = 1 To Anz
                    With .Item(f)
                        If .On Then
                            filterArray(f, 1) = .Criteria1
                            If .Operator Then
                                filterArray(f, 2) = .Operator
                                filterArray(f, 3) = .Criteria2
                            End If
                        End If
                    End With
                Next f
            End With
            With Sheets("TMP")
                .Cells.ClearContents
                .Range("A1").Resize(Anz, 3) = filterArray
            End With
        End With
    Else
        MsgBox "Kein Filter gesetzt"
    End If
End Sub
 
Sub ReDoAutoFilter()
    Dim w As Worksheet
    Dim filterArray()
    Dim currentFiltRange As String
    Dim col As Integer
    Dim Anz As Integer
    Set w = ActiveSheet
 
    ' Restore Filter settings
    If ActiveSheet.AutoFilterMode Then 'Ist überhaupt ein Filter gesetzt?
        Anz = w.AutoFilter.Filters.Count 'Anzahl der gesetzten Filter
        w.ShowAllData
        filterArray = Sheets("TMP").Range("A1").Resize(Anz, 3).Value
        currentFiltRange = w.AutoFilter.Range.Address
       
        For col = 1 To Anz
            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
    Else
        MsgBox "Kein Filter gesetzt"
    End If
End Sub

Danke schonmal im Vorraus,

LG
Timo


Im Anhang ist eine Beispieltabelle
  Beispieltabelle_Filter_speichern.xlsm (Größe: 21,51 KB / Downloads: 8)

[Rabe]

Hi,

das Thema klingt interessant, leider habe ich auch keine Ahnung vom Array-Programmieren.

[schauan]

Hallöchen,

eine genauere Fehlerbeschreibung ist sicher hilfreich. Du kannst dazu den Code schrittweise bis zum Fehler ausführen ...
w.ShowAllData bringt einen Fehler, wenn die Liste nicht gefiltert ist. Prüfe das vorher, z.B. so:

If w.AutoFilter.FilterMode Then w.ShowAllData