多列自动过滤Excel VBA

Question

我需要过滤一个数据表，其中3列可以包含我要查找的结果：

因此，如果在第1,2或3列中找到条件，则应返回该行。

Data http://im69.gulfup.com/gBZHK.png

因此，在上面的示例数据中，我可以选择标准为＆＃34; Fat＆＃34;

我正在寻找自动过滤器来返回第1行和第1行。 2;如果我选择标准为＆＃34;搞笑＆＃34;我需要第2行和第2行。 6等等....

下面是我的代码无效，因为显然它试图找到所有列都包含条件的行，而这不是我想要做的。

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但是当我运行代码时它没有返回任何结果。

简而言之：过滤器必须返回行，条件是在B列或C或D列中找到。

非常感谢帮助。

Answer 1

作为评论的后续内容，有两种方式可供您使用。

使用带公式的附加列：

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