VBA中的自动过滤器[重复]答案

【问题标题】：Auto Filter in VBA [duplicate]VBA中的自动过滤器[重复]
【发布时间】：2018-10-12 22:57:53
【问题描述】：

我想自动过滤列“FP” 有大约 200 个名称，我想查看除选定的几个名称之外的所有名称。即我想在过滤器下拉框中选择除指定名称之外的所有内容。

Sub Button1_Click()


With Worksheets("RawData")

  .AutoFilterMode = False

  .AutoFilter Field:=172, Criteria1:="<>John", Criteria2:="<>Kelly", 
  Criteria4:="<>Don", Criteria5:="<>Chris"

End With

MsgBox (a)

End Sub

【问题讨论】：

标签： excel vba autofilter

【解决方案1】：

您不能选择超过 2 个值来过滤掉。因此，我们构建了一个包含您要过滤掉的值的数组，然后我们为这些值着色。然后我们可以使用条件格式来过滤所有没有颜色的值。

缺点是最后一部分删除了应用过滤器的范围的所有条件格式。您可以删除该部分并手动删除包含数组值的条件格式。

VBA 代码应用于您的数据：

Sub Button1_Click()

Dim fc As FormatCondition
Dim ary1 As Variant
fcOrig = ActiveSheet.Cells.FormatConditions.Count
ary1 = Array("John", "Kelly", "Don", "Chris")

For Each str1 In ary1
    Set fc = ActiveSheet.Range("FP:FP").FormatConditions.Add(Type:=xlTextString, String:=str1, TextOperator:=xlContains)
    fc.Interior.Color = 16841689
    fc.StopIfTrue = False
Next str1
ActiveSheet.Range("FP:FP").AutoFilter Field:=1, Operator:=xlFilterNoFill
'Last Part of code remove all the conditional formatting for the range set earlier.
Set fc = Nothing
    If fcOrig = 0 Then
    fcOrig = 1
        For fcCount = ActiveSheet.Cells.FormatConditions.Count To fcOrig Step -1
        ActiveSheet.Cells.FormatConditions(fcCount).Delete
        Next fcCount
    Else
        For fcCount = ActiveSheet.Cells.FormatConditions.Count To fcOrig Step -1
        ActiveSheet.Cells.FormatConditions(fcCount).Delete
        Next fcCount
    End If
MsgBox (a)

End Sub

【讨论】：

【解决方案2】：

很遗憾，没有内置的方法可以做到这一点。

幸运的是，它仍然是可能的。

我把这个函数放在一起，它会过滤你的值。它的作用是列出要自动过滤的范围内的所有值，然后删除要排除的值。

此函数仅返回要保留的值数组。因此，从技术上讲，您并没有按排除列表进行过滤。

请注意：这具有最少的测试

Function filterExclude(filterRng As Range, ParamArray excludeVals() As Variant) As Variant()

    Dim allValsArr() As Variant, newValsArr() As Variant

    Rem: Get all values in your range
    allValsArr = filterRng

    Rem: Remove the excludeVals from the allValsArr
    Dim aVal As Variant, eVal As Variant, i As Long, bNoMatch As Boolean
    ReDim newValsArr(UBound(allValsArr) - UBound(excludeVals(0)) - 1)
    For Each aVal In allValsArr
        bNoMatch = True
        For Each eVal In excludeVals(0)
            If eVal = aVal Then
                bNoMatch = False
                Exit For
            End If
        Next eVal
        If bNoMatch Then
            newValsArr(i) = aVal
            i = i + 1
        End If
    Next aVal

    filterExclude = newValsArr

End Function

然后你会像这样使用上面的函数：

Sub test()

    Dim ws As Worksheet, filterRng As Range
    Set ws = ThisWorkbook.Worksheets(1)
    Set filterRng = ws.UsedRange.Columns("A")

    With filterRng
        .AutoFilter Field:=1, Criteria1:=filterExclude(filterRng, _
                Array("Blah2", "Blah4", "Blah6", "Blah8")), Operator:=xlFilterValues
    End With

End Sub

您的Criteria1 设置为等于filterExclude() 函数返回的数组。

在您的特定情况下，您的代码如下所示：

Sub Button1_Click()

    Dim ws As Worksheet, filterRng As Range, exclVals() As Variant
    Set ws = ThisWorkbook.Worksheets("RawData")
    Set filterRng = ws.UsedRange.Columns("FP")
    exclVals = Array("John", "Kelly", "Don", "Chris")

    ws.AutoFilterMode = False

    With filterRng

        .AutoFilter Field:=1, Criteria1:=filterExclude(filterRng, exclVals), _
                Operator:=xlFilterValues
    End With

End Sub

只要你也有我在公共模块中提供的功能。

现场观看

【讨论】：