chef1568
Nov 10, 2014, updated at 14:54:01 (UTC)
view6528
view9
0
Goto Top

Autofiltereinstellungen auslesen

GermansolvedQuestionVB for ApplicationsDevelopment
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.
comment-contentCommentShareShare
Share on Facebook Share on Twitter Share on Reddit Share on Linkedin

Content-Key: 254341

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

Printed on: April 24, 2024 at 22:04 o'clock

9 Comments
Latest comment
Goto Top
Mitglied: 114757
114757 Nov 10, 2014 updated at 12:33:59 (UTC)
Goto Top
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
Member: chef1568
chef1568 Nov 10, 2014 at 13:43:51 (UTC)
Goto Top
Hallo,

Ich meinte wenn Filter.count > 2 ist bekomme ich die Fehlermeldung "Typen unverträglich" in folgender Codezeile:
Wert_Filter1(i) = Filter.Criteria1

mfg
Mitglied: 114757
Solution 114757 Nov 10, 2014 updated at 14:54:00 (UTC)
Goto Top
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
Member: chef1568
chef1568 Nov 10, 2014 at 14:58:32 (UTC)
Goto Top
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
Mitglied: 116301
116301 Nov 10, 2014 at 15:11:35 (UTC)
Goto Top
Hallo chef1568 !

Variant = Empty:
If IsEmpty(Wert_Filter1(i)) Then

Grüße Dieter
Member: chef1568
chef1568 Nov 10, 2014 updated at 15:51:38 (UTC)
Goto Top
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 face-smile
Vielne Dank schonmal
Mitglied: 116301
Solution 116301 Nov 11, 2014, updated at Dec 04, 2014 at 08:25:57 (UTC)
Goto Top
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
Member: chef1568
chef1568 Dec 03, 2014 at 22:10:07 (UTC)
Goto Top
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 face-smile

danke
Mitglied: 116301
116301 Dec 04, 2014 updated at 08:42:05 (UTC)
Goto Top
Hallo chef1568!

In Zeile 51 rufst du noch den .Operator auf obwohl kein weiteres Kriterium vorhanden ist.
OK, hab ich wohl übersehen und oben rausgenommenface-wink

Grüße Dieter
GermansolvedQuestionVB for ApplicationsDevelopment
Hotly discussed
gleixnerdCheck of ZFW Firewallgleixnerd - 5 CommentsjstrickerWireguard VPN on UDM Pro behind Fritzbox - Handshake did not completejstricker - 3 Comments