Excel: Autofilter exceptions with more than two criteria

问题

This is a question that sometimes arises (e.g.: see here and here) and has almost always been given solutions based on some looping (with AutoFilter() itself or arrays)

For some reason Excel developers limited AutoFilter custom array criteria functioning to a maximum of two, so the following would not work:

    filterNotCriteria = Array("<>A","<>B","<>C")

    someRange.AutoFilter field:=1, Criteria1:=filterNotCriteria, Operator:=xlFilterValues

While I think it'd be really helpful to have this AutoFilter() functionality fully available as it is for its "not custom" counterpart

So, while awaiting for Excel developers to add it (or fix it, since it looks to me more like a bug), I'd start this question as a public survey (not sure if this is the appropriate way) on what could be the best VBA fix, both from the performance and usability point of view

And I'm adding the first answer to start the ball rolling

回答1:

My first thought was to stick to AutoFilter(), to benefit from its performance

Using some reverse thought, the steps would be:

filter with corresponding NOT(criteria)

so as to get what we don't need
hide the rows we got and that we don't need
leave with "wanted" rows

as follows:

Option Explicit

Function AutoFilterNot(rngToFilter As Range, fieldToFilterOn As Long, filterNotCriteria As Variant) As Range
    Dim notRng As Range ' helper range variable

    With rngToFilter ' reference wanted range to filter, headers row included
        .AutoFilter field:=fieldToFilterOn, Criteria1:=filterNotCriteria, Operator:=xlFilterValues ' filter on "not wanted" values
        If Application.Subtotal(103, .Resize(, 1)) > 1 Then ' if any filtered cell other than header row
            Set notRng = .Offset(1).Resize(.Rows.Count - 1).SpecialCells(xlCellTypeVisible) ' temporarily set 'myRng' to "not wanted" rows
            .Parent.AutoFilterMode = False ' remove filters and show all rows
            notRng.EntireRow.Hidden = True ' leave "wanted" rows only visible

            Set AutoFilterNot = .Offset(1).Resize(.Rows.Count - 1).SpecialCells(xlCellTypeVisible) ' get referenced range "wanted" rows

            .EntireRow.Hidden = False ' unhide all referenced range rows
        Else
            .Parent.AutoFilterMode = False ' remove filters
        End If
    End With
End Function

and that could be used in some "main" code as follows:

Dim filteredRng As Range

Set filteredRng = AutoFilterNot(Range("A1:C200"), 2, Array("B102", "A107"))

回答2:

Approach integrating repetitive Filter function

The idea is to define a include criteria array applying the Filter function negatively (i.e. via argument False) to exclude search items in array dont (containing all criteria you don't want to display).

Sub ExcludeThem()
' Purpose: exclude search terms "A","B" and "C" from AutoFilter display
' [0] temporary boundary delimiters needed (because of automatic wild card search by Filter function)
      Const delim$ = "."
' [1] define exclude criteria
      Dim dont
      dont = Array("A", "B", "C"): AddDelimiters dont, delim
' [2] define include items; consider dictionary keys instead to get only unique items :-)
      Dim include, rng As Range           ' change source range to your Needs (here A1:A10)
      Set rng = Sheet1.Range("A1:A10")    ' refers to sheet via CodeName, e.g. AutFlt or Sheet1
      include = Application.Transpose(rng.Value2): AddDelimiters include, delim
' [3] resize include items by subsequent filtering out dont items
      Dim i&
      For i = 0 To UBound(dont)
          include = Filter(include, dont(i), False, vbTextCompare)
      Next i
' [4] clear remaining include items from temporary delimiters
      RemoveDelimiters include, delim
' [5] Execute AutoFilter, cf. https://docs.microsoft.com/en-us/office/vba/api/excel.range.autofilter
      rng.AutoFilter field:=1, Criteria1:=include, Operator:=xlFilterValues
End Sub

Help procedures

Sub AddDelimiters(ByRef arr, Optional ByVal delim$ = ".")
' Purpose: add boundary delimiters to array items
  Dim i&
  For i = LBound(arr) To UBound(arr)
      arr(i) = delim & arr(i) & delim
  Next i
End Sub

Sub RemoveDelimiters(ByRef arr, Optional ByVal delim$ = ".")
' Purpose: remove boundary delimiters from array items
  Dim i&
  For i = LBound(arr) To UBound(arr)
      arr(i) = Replace(arr(i), delim, vbNullString)
  Next i
End Sub

来源：https://stackoverflow.com/questions/52246299/excel-autofilter-exceptions-with-more-than-two-criteria

标签

excel

vba

autofilter