Anzeige
Anzeige
HERBERS
Excel-Forum (Archiv)
20+ Jahre Excel-Kompetenz: Von Anwendern, für Anwender
Vorheriger Thread
Vorheriger Thread
Rückwärts Blättern
1800to1804
1800to1804
Aktuelles Verzeichnis
Verzeichnis Übersicht
Verzeichnis Übersicht
Übersicht Verzeichnisse
Nächster Thread
Nächster Thread
Vorwärts blättern
Inhaltsverzeichnis

Filter gibt Fehler aus

Forumthread: Filter gibt Fehler aus

Filter gibt Fehler aus
22.12.2020 10:09:05
Sarah
Guten Morgen.
Ich habe ein Makro vorliegen das mehrere Dateien abarbeitet. In diesen Dateien arbeitet das Makro mit Filtern von Spalten.
Das Problem ist jetzt nur, wenn es in einer Datei den Filter nicht ausführen kann, weil in dieser Datei die gefilterten Werte in der jeweiligen Spalte nicht vorhanden sind, gibt es mir einen Fehler aus und stoppt das Makro an dieser Stelle.
Kann ich irgendwie die Fehlermeldung ignorieren und es einfach weiter laufen lassen, ohne dass es mir dann das Makro stoppt und die Datei wo der Filter nicht anwendbar ist einfach ignoriert?
"
...
strFile = Dir$(strPath & strExt)
Do Until strFile = vbNullString
Workbooks.Open Filename:=(strPath & strFile), Local:=True
Set QWB = Workbooks(strFile)
'--------------
With QWB.Worksheets
'Filter
Selection.AutoFilter
ActiveSheet.Range("A:AK").AutoFilter Field:=4, Criteria1:=Array( _
"RLMMT", "RLMOT", "SLPANA", "SLPSYN"), Operator:=xlFilterValues
ActiveSheet.Range("A:AK").AutoFilter Field:=5, Criteria1:= _
"=BestOf 1", Operator:=xlOr, Criteria2:="=BestOf 2"
....
End With
'--------------
QWB.Close SaveChanges:=False
strFile = Dir$ ' nächste Datei
Loop
Set OWB = Nothing
End Sub"
Anzeige

6
Beiträge zum Forumthread
Beiträge zu diesem Forumthread

Betreff
Datum
Anwender
Anzeige
AW: Filter gibt Fehler aus
22.12.2020 10:30:02
Daniel
Hi
Man kann die Anweisung geben: 
On Error Resume Next

Danach gibt es keinen Fehlerstop mehr, sondern bei einem Fehler wird einfach mit der nächsten Programmteile weiter gemacht.
Um das wieder aufzuheben verwendet man die Anweisung 
On Error Goto 0
Das sollte man aber nur machen, wenn man sich sicher ist dass dies auch so korrekt ist und sich keine Fehler mehr zwischen diesen beiden Anweisungen befinden.
Die Alternative ist, dass man vor der zweiten Filterung prüft, ob die erste Filterung ein Ergebnis gebracht hat.
Das könnte man mit TEILERGEBNIS(3;A:A) (Anzahl2 für gefilterte Zeilen) tun:
Nach dem ersten Autofilter dann:
If WorksheetFunction.Subtotal(3, ActiveSheet.Columns(4)) > 1 then
Hier der Code für den 2. Autofilter
End If
Gruß Daniel
Anzeige
AW: Filter gibt Fehler aus
22.12.2020 11:02:40
Yal
Hallo Sarah,
ergänzend zu der -bereit sehr gute- Erklärung von Daniel:
die Fehlerhanldungsanweisung gelten nur innerhalb einer Sub/Function.
Es bietet sich an, den Code zu modularisieren, um spezifisches Handling einzurichten:
Sub Forum()
strFile = Dir$(strPath & strExt)
Do Until strFile = vbNullString
Workbooks.Open Filename:=(strPath & strFile), Local:=True
Set qwb = Workbooks(strFile)
'Filter
For Each WS In qwb.Worksheets
Spalte4_filtern WS
Spalte5_filtern WS
Next
With qwb.Worksheets
End With
qwb.Close SaveChanges:=False
strFile = Dir$ ' nächste Datei
Loop
Set OWB = Nothing
End Sub
Private Sub Spalte4_filtern(WS As Worksheet)
Const msg = "Filter für Spalte 4 nicht gefunden."
On Error GoTo Catch
Try:
If WS.AutoFilterMode = False Then WS.AutoFilter
WS.Range("A:AK").AutoFilter Field:=4, Criteria1:=Array("RLMMT", "RLMOT", "SLPANA", "SLPSYN") _
, Operator:=xlFilterValues
GoTo Finally
Catch:
Debug.Print "WB: """ & WS.Parent.Name & """, WS: """ & WS.Name & """, " & msg
Finally:
End Sub
Private Sub Spalte5_filtern(WS As Worksheet)
Const msg = "Filter für Spalte 5 nicht gefunden."
On Error GoTo Catch
Try:
If WS.AutoFilterMode = False Then WS.AutoFilter
WS.Range("A:AK").AutoFilter Field:=5, Criteria1:="=BestOf 1", Operator:=xlOr, Criteria2:="= _
BestOf 2"
GoTo Finally
Catch:
Debug.Print "WB: """ & WS.Parent.Name & """, WS: """ & WS.Name & """, " & msg
Finally:
End Sub

Als letzte Anweisung in Block "Catch" kann man 
Resume Next
haben. Dann sprint es auf die nächste Anweisung nach der Fehlerstelle zurück.
Viel Erfolg
Yal
Anzeige
AW: Filter gibt Fehler aus
22.12.2020 10:59:04
Nepumuk
Hallo Sarah,
teste mal:
    Dim vntFilterItem As Variant
    Dim strFilterValues() As String
    Dim ialngIndex As Long
    
    strFile = Dir$(strPath & strExt)
    
    Do Until strFile = vbNullString
        
        Workbooks.Open Filename:=(strPath & strFile), Local:=True
        Set QWB = Workbooks(strFile)
        '--------------
        With QWB.Worksheets
            
            'Filter
            For Each vntFilterItem In Array("RLMMT", "RLMOT", "SLPANA", "SLPSYN")
                
                If Not IsError(Application.Match(vntFilterItem, Columns(4), 0)) Then
                    
                    Redim Preserve strFilterValues(ialngIndex)
                    
                    strFilterValues(ialngIndex) = vntFilterItem
                    
                    ialngIndex = ialngIndex + 1
                    
                End If
            Next
            
            If ialngIndex > 0 Then
                
                ActiveSheet.Range("A:AK").AutoFilter Field:=4, _
                    Criteria1:=strFilterValues, Operator:=xlFilterValues
                
                ActiveSheet.Range("A:AK").AutoFilter Field:=5, Criteria1:= _
                    "=BestOf 1", Operator:=xlOr, Criteria2:="=BestOf 2"
                
            End If
        End With
        '--------------
        
        QWB.Close SaveChanges:=False
        
        strFile = Dir$ ' nächste Datei
        
    Loop
    
    Set OWB = Nothing
    
End Sub

Gruß
Nepumuk
Anzeige
AW: Filter gibt Fehler aus
22.12.2020 11:05:52
Yal
nicht vergessen, bei nächster Datei (Do While-Schleife), den ialngIndex vorher wieder auf null zu setzen.
;-)
AW: Filter gibt Fehler aus
22.12.2020 11:26:58
Nepumuk
Stimmt. Dann so:
    Dim vntFilterItem As Variant
    Dim strFilterValues() As String
    Dim ialngIndex As Long
    
    strFile = Dir$(strPath & strExt)
    
    Do Until strFile = vbNullString
        
        Set QWB = Workbooks.Open(Filename:=(strPath & strFile), Local:=True)
        
        '--------------
        With QWB.Worksheets
            
            'Filter
            For Each vntFilterItem In Array("RLMMT", "RLMOT", "SLPANA", "SLPSYN")
                
                If Not IsError(Application.Match(vntFilterItem, Columns(4), 0)) Then
                    
                    Redim Preserve strFilterValues(ialngIndex)
                    
                    strFilterValues(ialngIndex) = vntFilterItem
                    
                    ialngIndex = ialngIndex + 1
                    
                End If
            Next
            
            If ialngIndex > 0 Then
                
                ActiveSheet.Range("A:AK").AutoFilter Field:=4, _
                    Criteria1:=strFilterValues, Operator:=xlFilterValues
                
                ActiveSheet.Range("A:AK").AutoFilter Field:=5, Criteria1:= _
                    "=BestOf 1", Operator:=xlOr, Criteria2:="=BestOf 2"
                
                ialngIndex = 0
            End If
        End With
        '--------------
        
        QWB.Close SaveChanges:=False
        
        strFile = Dir$ ' nächste Datei
        
    Loop
    
    Set OWB = Nothing
    
End Sub

Gruß
Nepumuk
Anzeige
AW: Filter gibt Fehler aus
22.12.2020 11:39:08
Sarah
Ich danke euch vielmals! :)
;

Beliebteste Forumthreads (12 Monate)

Jetzt das Excel-Portal bewerten: Deine Stimme zählt!
Anzeige
Anzeige
Anzeige