如何在AutoFilter Excel中获取未选择的条件

Question

Using Excel 2007 with VBA We have a table. The user has filtered column 5 to certain items. I know I can get the currently selected criteria using:

'set table
Dim loStats As ListObject
Set loStats = ws.ListObjects("TableStats")

'get filter list
Dim af5 As Variant
af5 = loStats.AutoFilter.Filters(5).Criteria1

'print
Dim x As Integer
For x = LBound(af5) To UBound(af5)
    Debug.Print af5(x)
Next

But what about when the user has cleared the filter from column 5. This doesn't work after the user has cleared the filter in column 5

af5 = loStats.AutoFilter.Filters(5).Criteria1

How do I get the list of possible criteria like the user sees in the dropdown box?

Answer 1

So, where do I start?

Firstly, you falsely assume that the result will be an array. If I choose only one value, then LBound(af5) will return a type mismatch error. You can correct it with

If IsArray(Arr) Then
    For i = LBound(Arr) To UBound(Arr)
        Debug.Print Arr(i)
    Next
Else
    Debug.Print Arr
End If         

Unfortunately, this doesn't solve anything. Your procedure prints out not the currently filtered items, but the criteria chosen by the user. This will be misleading.

Consider a table with two columns. When the user specifies criteria as >3 the result that you will see is >3 . What does it actually tell you about the values which are filtered? You don't know how many (if any) were chosen and which ones they are. For example, the second column could store {1, 2, 3}, but also {3, 7, 99}.

This is the way I would do it:

Sub PrintOutFilteredData()
    Dim Tbl As ListObject
    Dim CellCount As Long
    Dim Cell As Range
    Dim Arr() As Variant
    Dim i As Long

    Set Tbl = ActiveSheet.ListObjects("Table1")

    On Error Resume Next
    CellCount = Tbl.DataBodyRange.Columns(2).SpecialCells(xlCellTypeVisible).Cells.Count
    If Err.Number = 1004 Then
        Debug.Print "All data was filtered out"
        Exit Sub
    End If

    For Each Cell In Tbl.DataBodyRange.Columns(2).SpecialCells(xlCellTypeVisible)
        If IsEmpty(Arr(0)) Then
            ReDim Arr(0 To 0)
            Arr(0) = Cell.Value
        Else
            ReDim Preserve Arr(0 To UBound(Arr) + 1)
            Arr(UBound(Arr)) = Cell.Value
        End If
    Next Cell

    For i = LBound(Arr) To UBound(Arr)
        Debug.Print Arr(i)
    Next i
End Sub

The use of On Error Resume Next prevents the procedure from throwing an error when there are no cells left visible, prints out a message and exits the procedure.