Hi,
danke für die Hilfe. Genau das hab ich bisher nie verstanden.
Das macht das ganze natürlich wieder etwas komplexer. Hab das jetzt so gelöst und in meinem Beispiel funktioniert es.
Public Sub Testo()
Dim vntCriteria, Array2d, Array3d As Variant
Set w = Worksheets("Test")
With w.AutoFilter
currentFiltRange = .Range.Address
ReDim vntCriteria(1 To .Filters.Count)
ReDim lngCount(1 To .Filters.Count)
For i = 1 To .Filters.Count
If .Filters(i).On Then
vntCriteria(i) = .Filters(i).Count
Else
vntCriteria(i) = 0
End If
Next i
MsgBox Join(vntCriteria, vbCrLf)
ReDim Array2d(1 To .Filters.Count, 1 To 3)
ReDim Array3d(1 To .Filters.Count)
For i = 1 To .Filters.Count
If vntCriteria(i) < 3 Then
With .Filters
With .Item(i)
If .On Then
Array2d(i, 1) = .Criteria1
If .Operator Then
Array2d(i, 2) = .Operator
Array2d(i, 3) = .Criteria2
End If
End If
End With
End With
ElseIf vntCriteria(i) > 2 Then
Array3d(i) = .Filters(i).Criteria1
End If
Next i
If ActiveSheet.FilterMode Then .ShowAllData
For i = 1 To .Filters.Count
If vntCriteria(i) < 3 Then
If Not IsEmpty(Array2d(i, 1)) Then
If Array2d(i, 2) Then
w.Range(currentFiltRange).AutoFilter Field:=i, _
Criteria1:=Array2d(i, 1), _
Operator:=Array2d(i, 2), _
Criteria2:=Array2d(i, 3)
Else
w.Range(currentFiltRange).AutoFilter Field:=i, _
Criteria1:=Array2d(i, 1)
End If
End If
ElseIf vntCriteria(i) > 2 Then
w.Range(currentFiltRange).AutoFilter Field:=i, Criteria1:=Array3d(i), Operator:=xlFilterValues
End If
Next i
End With
End Sub
Grüße
Achim
|