使用excel vba過濾出多個條件

Question

我在 A、1、2、3、4、5 和 A、B、C 列中有 8 個變量。
我的目標是過濾掉 A、B、C 並只顯示 1-5。

我可以使用以下代碼執行此操作：

My_Range.AutoFilter Field:=1, Criteria1:=Array("1", "2", "3","4","5"), _
    Operator:=xlFilterValues

但是代碼所做的是過濾變量 1 到 5 並顯示它們。

我想做相反的事情，但通過過濾掉 A、B、C 並顯示變量 1 到 5 來產生相同的結果

我試過這個代碼：

My_Range.AutoFilter Field:=1, Criteria1:=Array("<>A", "<>B", "<>C"), _
    Operator:=xlFilterValues

但它沒有用。

為什么我不能使用這個代碼？

它給出了這個錯誤：

運行時錯誤 1004 范圍類的自動過濾方法失敗

我該如何執行此操作？

Answer 1

我認為（從實驗中 - MSDN 在這里沒有幫助）沒有直接的方法可以做到這一點。 將Criteria1設置為Array等效於使用下拉列表中的復選框 - 正如您所說，它只會根據與數組中的項目匹配的項目過濾列表。

有趣的是，如果列表中有文字值"<>A"和"<>B"並在這些值上進行過濾，宏記錄器會給出

Range.AutoFilter Field:=1, Criteria1:="=<>A", Operator:=xlOr, Criteria2:="=<>B"

哪個有效。 但是，如果您隨后也有文字值"<>C" ，並且您在錄制宏時過濾了所有三個（使用勾選框），則宏錄制器會精確復制您的代碼，然后該代碼會失敗並出現錯誤。 我想我會稱其為錯誤 - 您可以使用 UI 執行過濾器，而 VBA 則無法執行這些過濾器。

無論如何，回到你的問題。 可以過濾不等於某些條件的值，但最多只能過濾兩個對您不起作用的值：

Range("$A$1:$A$9").AutoFilter Field:=1, Criteria1:="<>A", Criteria2:="<>B", Operator:=xlAnd

根據確切的問題，有幾種可能的解決方法：

1. 在 B 列中使用帶有公式的“輔助列”，然后對其進行過濾 - 例如=ISNUMBER(A2)或=NOT(A2="A", A2="B", A2="C")然后過濾TRUE
2. 如果您無法添加列，請使用帶有Criteria1:=">-65535" （或低於您預期的合適數字）的自動過濾器，這將過濾掉非數字值 - 假設這是您想要的
3. 編寫一個 VBA 子程序來隱藏行（與自動過濾器不完全相同，但根據您的需要它可能就足夠了）。

例如：

Public Sub hideABCRows(rangeToFilter As Range)
  Dim oCurrentCell As Range
  On Error GoTo errHandler

  Application.ScreenUpdating = False
  For Each oCurrentCell In rangeToFilter.Cells
    If oCurrentCell.Value = "A" Or oCurrentCell.Value = "B" Or oCurrentCell.Value = "C" Then
      oCurrentCell.EntireRow.Hidden = True
    End If
  Next oCurrentCell

  Application.ScreenUpdating = True
  Exit Sub

errHandler:
    Application.ScreenUpdating = True
End Sub

Answer 2

我在互聯網上沒有找到任何解決方案，所以我實現了一個。

帶有標准的自動過濾器代碼然后是

iColNumber = 1
Dim aFilterValueArray() As Variant
Call ConstructFilterValueArray(aFilterValueArray, iColNumber, Array("A", "B", "C"))

ActiveSheet.range(sRange).AutoFilter Field:=iColNumber _
    , Criteria1:=aFilterValueArray _
    , Operator:=xlFilterValues

事實上，ConstructFilterValueArray() 方法（不是函數）獲取它在特定列中找到的所有不同值，並刪除最后一個參數中存在的所有值。

這個方法的VBA代碼是

'************************************************************
'* ConstructFilterValueArray()
'************************************************************

Sub ConstructFilterValueArray(a() As Variant, iCol As Integer, aRemoveArray As Variant)

    Dim aValue As New Collection
    Call GetDistinctColumnValue(aValue, iCol)
    Call RemoveValueList(aValue, aRemoveArray)
    Call CollectionToArray(a, aValue)

End Sub

'************************************************************
'* GetDistinctColumnValue()
'************************************************************

Sub GetDistinctColumnValue(ByRef aValue As Collection, iCol As Integer)

    Dim sValue As String

    iEmptyValueCount = 0
    iLastRow = ActiveSheet.UsedRange.Rows.Count

    Dim oSheet: Set oSheet = Sheets("X")

    Sheets("Data")
        .range(Cells(1, iCol), Cells(iLastRow, iCol)) _
            .AdvancedFilter Action:=xlFilterCopy _
                          , CopyToRange:=oSheet.range("A1") _
                          , Unique:=True

    iRow = 2
    Do While True
        sValue = Trim(oSheet.Cells(iRow, 1))
        If sValue = "" Then
            If iEmptyValueCount > 0 Then
                Exit Do
            End If
            iEmptyValueCount = iEmptyValueCount + 1
        End If

        aValue.Add sValue
        iRow = iRow + 1
    Loop

End Sub

'************************************************************
'* RemoveValueList()
'************************************************************

Sub RemoveValueList(ByRef aValue As Collection, aRemoveArray As Variant)

    For i = LBound(aRemoveArray) To UBound(aRemoveArray)
        sValue = aRemoveArray(i)
        iMax = aValue.Count
        For j = iMax To 0 Step -1
            If aValue(j) = sValue Then
                aValue.Remove (j)
                Exit For
            End If
        Next j
     Next i

End Sub

'************************************************************
'* CollectionToArray()
'************************************************************

Sub CollectionToArray(a() As Variant, c As Collection)

    iSize = c.Count - 1
    ReDim a(iSize)

    For i = 0 To iSize
        a(i) = c.Item(i + 1)
    Next

End Sub

這段代碼當然可以在返回字符串數組方面得到改進，但在 VBA 中使用數組並不容易。

注意：此代碼僅在您定義名為 X 的工作表時才有效，因為 AdvancedFilter() 中使用的 CopyToRange 參數需要 Excel 范圍！

遺憾的是，微軟沒有通過簡單地添加一個新的枚舉作為 xlNotFilterValues 來實現這個解決方案！ ...或 xlRegexMatch ！

Answer 3

使用 VBA 的 Filter 函數的替代方法

作為@schlebe 最近答案的創新替代方案，我嘗試使用集成在VBA 中的Filter函數，它允許過濾掉給定的搜索字符串，將第三個參數設置為 False。 所有“否定”搜索字符串（例如 A、B、C）都定義在一個數組中。 我將 A 列中的條件讀取到數據字段數組中，並基本上執行后續過濾 (A - C) 以過濾掉這些項目。

代碼

Sub FilterOut()
Dim ws  As Worksheet
Dim rng As Range, i As Integer, n As Long, v As Variant
' 1) define strings to be filtered out in array
  Dim a()                    ' declare as array
  a = Array("A", "B", "C")   ' << filter out values
' 2) define your sheetname and range (e.g. criteria in column A)
  Set ws = ThisWorkbook.Worksheets("FilterOut")
  n = ws.Range("A" & ws.Rows.Count).End(xlUp).row
  Set rng = ws.Range("A2:A" & n)
' 3) hide complete range rows temporarily
  rng.EntireRow.Hidden = True
' 4) set range to a variant 2-dim datafield array
  v = rng
' 5) code array items by appending row numbers
  For i = 1 To UBound(v): v(i, 1) = v(i, 1) & "#" & i + 1: Next i
' 6) transform to 1-dim array and FILTER OUT the first search string, e.g. "A"
  v = Filter(Application.Transpose(Application.Index(v, 0, 1)), a(0), False, False)
' 7) filter out each subsequent search string, i.e. "B" and "C"
  For i = 1 To UBound(a): v = Filter(v, a(i), False, False): Next i
' 8) get coded row numbers via split function and unhide valid rows
  For i = LBound(v) To UBound(v)
      ws.Range("A" & Split(v(i) & "#", "#")(1)).EntireRow.Hidden = False
  Next i
End Sub

Answer 4

使用自動篩選的選項

---

Option Explicit

Public Sub FilterOutMultiple()
    Dim ws As Worksheet, filterOut As Variant, toHide As Range

    Set ws = ActiveSheet
    If Application.WorksheetFunction.CountA(ws.Cells) = 0 Then Exit Sub 'Empty sheet

    filterOut = Split("A B C D E F G")

    Application.ScreenUpdating = False
    With ws.UsedRange.Columns("A")
        If ws.FilterMode Then .AutoFilter
       .AutoFilter Field:=1, Criteria1:=filterOut, Operator:=xlFilterValues
        With .SpecialCells(xlCellTypeVisible)
            If .CountLarge > 1 Then Set toHide = .Cells 'Remember unwanted (A, B, and C)
        End With
       .AutoFilter
        If Not toHide Is Nothing Then
            toHide.Rows.Hidden = True                   'Hide unwanted (A, B, and C)
           .Cells(1).Rows.Hidden = False                'Unhide header
        End If
    End With
    Application.ScreenUpdating = True
End Sub

Answer 5

這是一個使用在某個范圍內寫入的列表的選項，填充將被過濾的數組。 信息將被刪除，然后對列進行排序。

Sub Filter_Out_Values()

'Automation to remove some codes from the list
Dim ws, ws1 As Worksheet
Dim myArray() As Variant
Dim x, lastrow As Long
Dim cell As Range

Set ws = Worksheets("List")
Set ws1 = Worksheets(8)
lastrow = ws.Cells(Application.Rows.Count, 1).End(xlUp).Row

'Go through the list of codes to exclude
For Each cell In ws.Range("A2:A" & lastrow)

    If cell.Offset(0, 2).Value = "X" Then 'If the Code is associated with "X"
        ReDim Preserve myArray(x) 'Initiate array
        myArray(x) = CStr(cell.Value) 'Populate the array with the code
        x = x + 1 'Increase array capacity
        ReDim Preserve myArray(x) 'Redim array
    End If

Next cell

lastrow = ws1.Cells(Application.Rows.Count, 1).End(xlUp).Row
ws1.Range("C2:C" & lastrow).AutoFilter field:=3, Criteria1:=myArray, Operator:=xlFilterValues
ws1.Range("A2:Z" & lastrow).SpecialCells(xlCellTypeVisible).ClearContents
ws1.Range("A2:Z" & lastrow).AutoFilter field:=3

'Sort columns
lastrow = ws1.Cells(Application.Rows.Count, 1).End(xlUp).Row
'Sort with 2 criteria
With ws1.Range("A1:Z" & lastrow)
    .Resize(lastrow).Sort _
    key1:=ws1.Columns("B"), order1:=xlAscending, DataOption1:=xlSortNormal, _
    key2:=ws1.Columns("D"), order1:=xlAscending, DataOption1:=xlSortNormal, _
    Header:=xlYes, MatchCase:=False, Orientation:=xlTopToBottom, SortMethod:=xlPinYin
End With

End Sub

Answer 6

這對我有用：這是兩個字段/列（9 和 10）的標准，這將過濾第 9 列值 > 0 的行和第 10 列值lastrow和 8 的行。 lastrow是行數在數據部分。

ActiveSheet.Range("$A$1:$O$" & lastrow).AutoFilter Field:=9, Criteria1:=">0", Operator:=xlAnd
ActiveSheet.Range("$A$1:$O$" & lastrow).AutoFilter Field:=10, Criteria1:=Arr("4","7","8"), Operator:=xlFilterValues

Answer 7

請檢查這個以過濾出范圍內的值。 有用

Selection.AutoFilter field:=33, Criteria1:="<>Array(IN1R,IN2R,INDA)", Operator:=xlFilterValues

實際上上面的代碼不起作用。 因此，只要活動單元格具有我正在搜索的值，我就會給出一個循環來隱藏整行。

對於選擇中的每個單元格 如果 cell.value = “IN1R” 或 cell.value = “INR2” 或 cell.value = “INDA” 然后

  Else

  Activecell.Entirerow.Hidden = True

 End if

下一個

Answer 8

我在A，1、2、3、4、5列和A，B，C中有8個變量。
我的目的是過濾掉A，B，C並僅顯示1-5。

我可以使用以下代碼執行此操作：

My_Range.AutoFilter Field:=1, Criteria1:=Array("1", "2", "3","4","5"), _
    Operator:=xlFilterValues

但是代碼的作用是過濾變量1到5並顯示它們。

我想做相反的事情，但通過濾除A，B，C並顯示變量1至5產生相同的結果

我嘗試了這段代碼：

My_Range.AutoFilter Field:=1, Criteria1:=Array("<>A", "<>B", "<>C"), _
    Operator:=xlFilterValues

但這沒有用。

為什么我不能使用此代碼？

它給出了這個錯誤：

范圍類別的執行階段錯誤1004自動篩選方法失敗

我該如何執行呢？