Hallo! Also musste den Code mal umstellen, da mein Excel hier meckerte. Ist getestet und läuft. Erster geht auch. Bezug ist jetzt der Filter i Zeile2 und die Daten ab Zeile 3. Bitte mal probieren. VG
Dim stelle As Long
Sub filter_zurück()
Dim liste()
ReDim liste(0)
stelle = stelle - 1
If ActiveSheet.AutoFilterMode = True Then Range("A2:P2").AutoFilter
'Zeile 1 ist Übeschrift
For i = 3 To ActiveSheet.Cells(Rows.Count, 1).End(xlUp).Row
'MsgBox liste.contains(Cells(i, 1))
If UBound(filter(liste, CStr(ActiveSheet.Cells(i, 1)), , vbBinaryCompare)) = -1 Then
liste(0) = liste(0) + 1
ReDim Preserve liste(liste(0))
liste(liste(0)) = CStr(ActiveSheet.Cells(i, 1))
End If
Next
If stelle = -1 Then stelle = UBound(liste)
If stelle = 0 Then
Exit Sub
End If
Range("A2:P2").AutoFilter
Range("A2:P2").AutoFilter Field:=1, Criteria1:=Replace(liste(stelle), ",", ".")
End Sub
Sub filter_vor()
Dim liste()
ReDim liste(0)
stelle = stelle + 1
If ActiveSheet.AutoFilterMode = True Then Range("A2:P2").AutoFilter
'Zeile 1 ist Übeschrift
For i = 3 To ActiveSheet.Cells(Rows.Count, 1).End(xlUp).Row
'MsgBox liste.contains(Cells(i, 1))
If UBound(filter(liste, CStr(ActiveSheet.Cells(i, 1)), , vbBinaryCompare)) = -1 Then
liste(0) = liste(0) + 1
ReDim Preserve liste(liste(0))
liste(liste(0)) = CStr(ActiveSheet.Cells(i, 1))
End If
Next
Debug.Print stelle
If stelle > UBound(liste) Then
stelle = 0
Exit Sub
End If
Range("A2:P2").AutoFilter
Range("A2:P2").AutoFilter Field:=1, Criteria1:=Replace(liste(stelle), ",", ".")
End Sub
Sub erster()
If ActiveSheet.AutoFilterMode = True Then Range("A2:P2").AutoFilter
stelle = 1
Range("A2:P2").AutoFilter
Range("A2:P2").AutoFilter Field:=1, Criteria1:=Replace(CStr(ActiveSheet.Cells(3, 1)), ",", ".")
End Sub
|