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