Autofiltereinstellungen auslesen

Hallo,

ich habe derzeit ein Problem mit dem Auslesen eines Autofilters.

Dim Wert_Filter1() As String, Wert_Filter2() As String
Dim Wert_UndOder(), Filteranzahl As Integer
Dim i As Integer, Filter As Object, ZeileAutoFilter As Range
Dim FilterOff As Boolean

With Worksheets("Fahrzeugübersicht")  
    If .FilterMode = True Then
        Set ZeileAutoFilter = .Rows(1) 'Zeile Autofilter  
        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 Filter In .Autofilter.Filters
                If Filter.On Then
                    Wert_Filter1(i) = Filter.Criteria1
                    Wert_UndOder(i) = Filter.Operator
                    
                    On Error Resume Next
                    Wert_Filter2(i) = Filter.Criteria2
                End If
                i = i + 1
            Next
          End If
          
          .Autofilter = False
    End If
End With

Hier habe ich das Problem dass, sobald mehr als 2 Kriterien pro Filter aktiv sind funktioniert das Script nicht mehr.

Bitte markiere auch die Kommentare, die zur Lösung des Beitrags beigetragen haben

Content-ID: 254341

Url: https://administrator.de/contentid/254341

Ausgedruckt am: 22.11.2024 um 22:11 Uhr

9 Kommentare

Neuester Kommentar

Hallo Chef,

Zitat von @chef1568:
Hier habe ich das Problem dass, sobald mehr als 2 Kriterien pro Filter aktiv sind funktioniert das Script nicht mehr.

verstehe ich nicht, wie soll ein AutoFilter mehr wie 2 Kriterien haben, das geht doch gar nicht ?? 2 ist das Maximum pro Filter.
Ob ein Filter ein oder zwei Kriterien hat kannst du mit Filter.Count abfragen, und dann mit einer IF-Abfrage abfangen.

'.....  
               If Filter.On Then
                    Wert_Filter1(i) = Filter.Criteria1
                    if Filter.Count > 1 then
                       Wert_UndOder(i) = Filter.Operator
                       Wert_Filter2(i) = Filter.Criteria2
                    End if
                End If
'......  

Gruß jodel32

Hallo,

Ich meinte wenn Filter.count > 2 ist bekomme ich die Fehlermeldung "Typen unverträglich" in folgender Codezeile:

Wert_Filter1(i) = Filter.Criteria1

mfg

Zitat von @chef1568:
Ich meinte wenn Filter.count > 2 ist bekomme ich die Fehlermeldung "Typen unverträglich" in folgender
Codezeile:

Ach so OK, du musst deine Array-Variablen als Variant anstatt String deklarieren, weil du bei mehreren Werten (bzw. xlFilterValues) ein Array zugeliefert bekommst, deswegen der Typen-Fehler. Du kannst ja ein Array nicht einer String-Variablen zuweisen.

dim Wert_Filter1() as Variant
dim Wert_Filter2() as Variant

Super, jetzt funktioniert das Erfassen des Filters schonmal.

Leider habe jetzt beim Wiederherstellen der Filter ein Problem mit dem Variant in Zeile 3 "Typen unverträglich"

With Worksheets("Fahrzeugübersicht")  
        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
End With

Danke schonmal

Hallo chef1568 !

Variant = Empty:

If IsEmpty(Wert_Filter1(i)) Then

Grüße Dieter

Also der Code läuft jetzt zwar ohne Fehler durch, jedoch werden mir nicht mehr die ursprünglich gesetzten Filter wiederhergestellt.
Irgendwas wird hier verworfen.

Hier nochmal der komplette Code:

Sub Autofilter()
'###################################################################  
'####################### Autofilter einlesen #######################  
'###################################################################  
Dim Wert_Filter1(), Wert_Filter2(), Wert_UndOder() As Variant
Dim Filteranzahl As Integer
Dim i As Integer, Filter As Object, ZeileAutoFilter As Range
Dim FilterOff As Boolean

With Worksheets("Fahrzeugübersicht")  
    If .FilterMode = True Then
        Set ZeileAutoFilter = .Rows(1) 'Zeile Autofilter  
        Filteranzahl = .Autofilter.Filters.Count
          
        ReDim Preserve Wert_Filter1(Filteranzahl)
        ReDim Preserve Wert_Filter2(Filteranzahl)
        ReDim Preserve Wert_UndOder(Filteranzahl)
          On Error Resume Next
        If .AutoFilterMode Then
            i = 1
            For Each Filter In .Autofilter.Filters
                If Filter.On Then
                    Wert_Filter1(i) = Filter.Criteria1
                    If Filter.Count > 1 Then
                        Wert_UndOder(i) = Filter.Operator
                        Wert_Filter2(i) = Filter.Criteria2
                    End If
                End If
                i = i + 1
            Next
          End If
          
          .AutoFilterMode = False
    Else
        FilterOff = True
    End If
End With
'###################################################################  
'####################### Autofilter einlesen #######################  
'###################################################################  

'###################################################################  
'################### Autofilter wiederherstellen ###################  
'###################################################################  
Worksheets("Fahrzeugübersicht").Select  
Rows("1:1").Select  
Selection.Autofilter

With Worksheets("Fahrzeugübersicht")  
    If FilterOff = False Then
        For i = 1 To Filteranzahl
            If IsEmpty(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
    End If
End With
'###################################################################  
'################### Autofilter wiederherstellen ###################  
'###################################################################  
End Sub

vielleicht fällt jemandem das Problem auf

Vielne Dank schonmal

Hallo chef1568!

So sollte es klappen:

Option Explicit

Private Type FilterData
    On As Boolean
    Count As Long
    Criteria1 As Variant
    Criteria2 As Variant
    Operator As Long
End Type

Public Sub Autofilter()
    Dim arrFilters() As FilterData, rngFilters As Range, bolFilters As Boolean, i As Integer
    
    '#######Einlesen  
    
    With Worksheets("Fahrzeugübersicht")  
        If .AutoFilterMode Then
            With .Autofilter
                ReDim arrFilters(1 To .Filters.Count)
                
                For i = 1 To .Filters.Count
                    With .Filters(i)
                        If .On Then
                            arrFilters(i).On = .On
                            arrFilters(i).Count = .Count
                            arrFilters(i).Operator = .Operator
                            arrFilters(i).Criteria1 = .Criteria1
                            If .Count = 2 Then
                                arrFilters(i).Criteria2 = .Criteria2
                            End If
                        End If
                    End With
                Next
            End With
            bolFilters = True
           .AutoFilterMode = False
        End If
    End With
    
    '#######Wiederherstellen  
    
    If bolFilters Then
        Set rngFilters = Worksheets("Fahrzeugübersicht").Rows(1)  
        
        rngFilters.Autofilter   'Auch setzen, wenn alle On=False?   
       
        For i = 1 To UBound(arrFilters)
            With arrFilters(i)
                If .On Then
                    If .Count = 1 Then
                        rngFilters.Autofilter i, .Criteria1
                    Else
                        rngFilters.Autofilter i, .Criteria1, .Operator, .Criteria2
                    End If
                End If
            End With
        Next
    End If
End Sub

Grüße Dieter

Hallo Dieter,

du hast noch einen kleinen Fehler in dem Code.
In Zeile 51 rufst du noch den .Operator auf obwohl kein weiteres Kriterium vorhanden ist.
Ansonsten funktioniert der Code

danke