使用 excel vba 筛选出多个条件
filter out multiple criteria using excel vba
我在 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
但是没有用。
为什么我不能使用此代码?
它给出了这个错误:
Run time error 1004 autofilter method of range class failed
如何执行此操作?
我认为(通过试验 - MSDN 在这里没有帮助)没有直接的方法可以做到这一点。将 Criteria1
设置为 Array
相当于使用下拉列表中的勾选框 - 正如您所说,它只会根据与数组中的其中一项匹配的项目过滤列表。
有趣的是,如果您在列表中有文字值 "<>A"
和 "<>B"
并过滤这些值,宏记录器会生成
Range.AutoFilter Field:=1, Criteria1:="=<>A", Operator:=xlOr, Criteria2:="=<>B"
有效。但是,如果您随后也具有字面值 "<>C"
并且在录制宏时过滤所有三个(使用复选框),则宏录制器会精确复制您的代码,然后失败并出现错误。我想我会称之为一个错误 - 有些过滤器你可以使用 UI 来做,而你不能用 VBA.
无论如何,回到你的问题。可以过滤不等于某些条件的值,但最多只能过滤两个不适合您的值:
Range("$A:$A").AutoFilter Field:=1, Criteria1:="<>A", Criteria2:="<>B", Operator:=xlAnd
根据具体问题,有几种可能的解决方法:
- 使用 "helper column" 和 B 列中的公式,然后对其进行过滤 - 例如
=ISNUMBER(A2)
或 =NOT(A2="A", A2="B", A2="C")
然后过滤 TRUE
- 如果您无法添加列,请使用带
Criteria1:=">-65535"
的自动筛选器(或低于您预期的合适数字),这将筛选出非数字值 - 假设这是您想要的
- 写一个 VBA sub 来隐藏行(与自动过滤器不完全相同,但根据您的需要可能就足够了)。
例如:
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
我在网上没有找到任何解决方案,所以我实现了一个。
然后是带有条件的自动过滤器代码
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 的 sheet 时有效,因为 AdvancedFilter() 中使用的 CopyToRange 参数需要一个 Excel 范围 !
遗憾的是,Microsoft 没有通过简单地添加一个新枚举作为 xlNotFilterValues 来实现此解决方案! ... 或 xlRegexMatch !
使用 VBA 的过滤功能的替代方法
作为@schlebe 最近回答的创新替代方案,我尝试使用集成在 VBA 中的 Filter
函数,它允许 过滤掉 给定的搜索字符串,将第三个参数设置为 False。所有 "negative" 搜索字符串(例如 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
使用自动筛选的选项
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
这里有一个选项,使用写在某个范围内的列表,填充一个将被过滤的数组。信息将被删除,然后对列进行排序。
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
这对我有用:
这是一个超过两个 fields/columns(9 和 10)的条件,它过滤第 9 列上值 >0 的行和第 10 列上值 4、7 和 8 的行。lastrow
是数据部分的行数。
ActiveSheet.Range("$A:$O$" & lastrow).AutoFilter Field:=9, Criteria1:=">0", Operator:=xlAnd
ActiveSheet.Range("$A:$O$" & lastrow).AutoFilter Field:=10, Criteria1:=Arr("4","7","8"), Operator:=xlFilterValues
请选中此选项以过滤掉某个范围内的值。有效
Selection.AutoFilter 字段:=33, Criteria1:="<>Array(IN1R,IN2R,INDA)", 运算符:=xlFilterValues
实际上上面的代码并没有起作用。因此,只要活动单元格具有我正在搜索的值,我就会给出一个循环来隐藏整行。
对于选择中的每个单元格
如果 cell.value = “IN1R” 或 cell.value = “INR2” 或 cell.value = “INDA” 那么
Else
Activecell.Entirerow.Hidden = True
End if
下一个
我在 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
但是没有用。
为什么我不能使用此代码?
它给出了这个错误:
Run time error 1004 autofilter method of range class failed
如何执行此操作?
我认为(通过试验 - MSDN 在这里没有帮助)没有直接的方法可以做到这一点。将 Criteria1
设置为 Array
相当于使用下拉列表中的勾选框 - 正如您所说,它只会根据与数组中的其中一项匹配的项目过滤列表。
有趣的是,如果您在列表中有文字值 "<>A"
和 "<>B"
并过滤这些值,宏记录器会生成
Range.AutoFilter Field:=1, Criteria1:="=<>A", Operator:=xlOr, Criteria2:="=<>B"
有效。但是,如果您随后也具有字面值 "<>C"
并且在录制宏时过滤所有三个(使用复选框),则宏录制器会精确复制您的代码,然后失败并出现错误。我想我会称之为一个错误 - 有些过滤器你可以使用 UI 来做,而你不能用 VBA.
无论如何,回到你的问题。可以过滤不等于某些条件的值,但最多只能过滤两个不适合您的值:
Range("$A:$A").AutoFilter Field:=1, Criteria1:="<>A", Criteria2:="<>B", Operator:=xlAnd
根据具体问题,有几种可能的解决方法:
- 使用 "helper column" 和 B 列中的公式,然后对其进行过滤 - 例如
=ISNUMBER(A2)
或=NOT(A2="A", A2="B", A2="C")
然后过滤TRUE
- 如果您无法添加列,请使用带
Criteria1:=">-65535"
的自动筛选器(或低于您预期的合适数字),这将筛选出非数字值 - 假设这是您想要的 - 写一个 VBA sub 来隐藏行(与自动过滤器不完全相同,但根据您的需要可能就足够了)。
例如:
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
我在网上没有找到任何解决方案,所以我实现了一个。
然后是带有条件的自动过滤器代码
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 的 sheet 时有效,因为 AdvancedFilter() 中使用的 CopyToRange 参数需要一个 Excel 范围 !
遗憾的是,Microsoft 没有通过简单地添加一个新枚举作为 xlNotFilterValues 来实现此解决方案! ... 或 xlRegexMatch !
使用 VBA 的过滤功能的替代方法
作为@schlebe 最近回答的创新替代方案,我尝试使用集成在 VBA 中的 Filter
函数,它允许 过滤掉 给定的搜索字符串,将第三个参数设置为 False。所有 "negative" 搜索字符串(例如 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
使用自动筛选的选项
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
这里有一个选项,使用写在某个范围内的列表,填充一个将被过滤的数组。信息将被删除,然后对列进行排序。
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
这对我有用:
这是一个超过两个 fields/columns(9 和 10)的条件,它过滤第 9 列上值 >0 的行和第 10 列上值 4、7 和 8 的行。lastrow
是数据部分的行数。
ActiveSheet.Range("$A:$O$" & lastrow).AutoFilter Field:=9, Criteria1:=">0", Operator:=xlAnd
ActiveSheet.Range("$A:$O$" & lastrow).AutoFilter Field:=10, Criteria1:=Arr("4","7","8"), Operator:=xlFilterValues
请选中此选项以过滤掉某个范围内的值。有效
Selection.AutoFilter 字段:=33, Criteria1:="<>Array(IN1R,IN2R,INDA)", 运算符:=xlFilterValues
实际上上面的代码并没有起作用。因此,只要活动单元格具有我正在搜索的值,我就会给出一个循环来隐藏整行。
对于选择中的每个单元格 如果 cell.value = “IN1R” 或 cell.value = “INR2” 或 cell.value = “INDA” 那么
Else
Activecell.Entirerow.Hidden = True
End if
下一个