|
Hallo Louis! Also hier die Variante für deine Filter. Weil eh nur Fußball kommt, habe ich es mal so gebastelt, dass du auch mehrere zusätzliche Filter einstellen kannst - ist dadurch etwas länger geworden. :- ) Zusätzlich gibt es noch die Sub alle_leeren. DAmit setzt du den Filter praktisch komplett zurück (also alle Spalten). Bitte mal schauen, ob es passt. In meiner Übungsumgebung funktionierte es zumindest. VG
Option Explicit
Dim stelle As Long
Sub filter_zurück()
Dim liste()
Dim daten()
Dim filterwerte()
ReDim liste(0)
Dim i As Long
Dim j As Long
Dim eintrag As Boolean
ReDim filterwerte(ActiveSheet.AutoFilter.Filters.Count)
'nur das erste Kriterium
For i = 2 To ActiveSheet.AutoFilter.Range.Columns.Count
If ActiveSheet.AutoFilter.Filters(i).On Then
filterwerte(i) = Right(ActiveSheet.AutoFilter.Filters(i).Criteria1, Len(ActiveSheet.AutoFilter.Filters(i).Criteria1) - 1)
Else
filterwerte(i) = ""
End If
Next i
daten = Range(ActiveSheet.AutoFilter.Range.Address)
stelle = stelle - 1
If ActiveSheet.AutoFilterMode = True Then
'Zeile 1 ist Übeschrift
For i = 2 To ActiveSheet.AutoFilter.Range.Rows.Count
eintrag = True
If UBound(filter(liste, CStr(daten(i, 1)), , vbBinaryCompare)) = -1 Then
For j = 2 To ActiveSheet.AutoFilter.Range.Columns.Count
If filterwerte(j) <> "" Then
If CStr(daten(i, j)) <> filterwerte(j) Then eintrag = False
End If
Next j
If eintrag = True Then
liste(0) = liste(0) + 1
ReDim Preserve liste(liste(0))
liste(liste(0)) = CStr(daten(i, 1))
End If
End If
Next
If stelle = -1 Then stelle = UBound(liste)
If stelle = 0 Then
Range("Auftragsliste").AutoFilter Field:=1
Exit Sub
End If
Range("Auftragsliste").AutoFilter Field:=1, Criteria1:=Replace(liste(stelle), ",", ".")
Else
ActiveSheet.AutoFilterMode
End If
End Sub
Sub filter_vor()
Dim liste()
Dim daten()
Dim filterwerte()
ReDim liste(0)
Dim i As Long
Dim j As Long
Dim eintrag As Boolean
ReDim filterwerte(ActiveSheet.AutoFilter.Filters.Count)
'nur das erste Kriterium
For i = 2 To ActiveSheet.AutoFilter.Range.Columns.Count
If ActiveSheet.AutoFilter.Filters(i).On Then
filterwerte(i) = Right(ActiveSheet.AutoFilter.Filters(i).Criteria1, Len(ActiveSheet.AutoFilter.Filters(i).Criteria1) - 1)
Else
filterwerte(i) = ""
End If
Next i
daten = Range(ActiveSheet.AutoFilter.Range.Address)
stelle = stelle + 1
If ActiveSheet.AutoFilterMode = True Then
'Zeile 1 ist Übeschrift
For i = 2 To ActiveSheet.AutoFilter.Range.Rows.Count
eintrag = True
If UBound(filter(liste, CStr(daten(i, 1)), , vbBinaryCompare)) = -1 Then
For j = 2 To ActiveSheet.AutoFilter.Range.Columns.Count
If filterwerte(j) <> "" Then
If CStr(daten(i, j)) <> filterwerte(j) Then eintrag = False
End If
Next j
If eintrag = True Then
liste(0) = liste(0) + 1
ReDim Preserve liste(liste(0))
liste(liste(0)) = CStr(daten(i, 1))
End If
End If
Next
If stelle > UBound(liste) Then stelle = 0
If stelle = 0 Then
Range("Auftragsliste").AutoFilter Field:=1
Exit Sub
End If
Range("Auftragsliste").AutoFilter Field:=1, Criteria1:=Replace(liste(stelle), ",", ".")
Else
Range("Auftragsliste").AutoFilter
End If
End Sub
Sub erster()
Dim liste()
Dim daten()
Dim filterwerte()
ReDim liste(0)
Dim i As Long
Dim j As Long
Dim eintrag As Boolean
ReDim filterwerte(ActiveSheet.AutoFilter.Filters.Count)
'nur das erste Kriterium
For i = 2 To ActiveSheet.AutoFilter.Range.Columns.Count
If ActiveSheet.AutoFilter.Filters(i).On Then
filterwerte(i) = Right(ActiveSheet.AutoFilter.Filters(i).Criteria1, Len(ActiveSheet.AutoFilter.Filters(i).Criteria1) - 1)
Else
filterwerte(i) = ""
End If
Next i
daten = Range(ActiveSheet.AutoFilter.Range.Address)
If ActiveSheet.AutoFilterMode = True Then
'Zeile 1 ist Übeschrift
For i = 2 To ActiveSheet.AutoFilter.Range.Rows.Count
eintrag = True
If UBound(filter(liste, CStr(daten(i, 1)), , vbBinaryCompare)) = -1 Then
For j = 2 To ActiveSheet.AutoFilter.Range.Columns.Count
If filterwerte(j) <> "" Then
If CStr(daten(i, j)) <> filterwerte(j) Then eintrag = False
End If
Next j
If eintrag = True Then
liste(0) = liste(0) + 1
ReDim Preserve liste(liste(0))
liste(liste(0)) = CStr(daten(i, 1))
End If
End If
Next
If UBound(liste) > 0 Then
stelle = 1
Else
Exit Sub
End If
Range("Auftragsliste").AutoFilter Field:=1, Criteria1:=Replace(liste(stelle), ",", ".")
Else
Range("Auftragsliste").AutoFilter
End If
End Sub
Sub alle_leeren()
If ActiveSheet.AutoFilterMode = True Then Range("Auftragsliste").AutoFilter
Range("Auftragsliste").AutoFilter
stelle = 0
End Sub
|