自动过滤器在多列Excel VBA [英] Autofilter on Mutliple Columns Excel VBA

问题描述

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

因此，如果标准在第1,2或3列中找到那么该行应该被返回。

数据http ：//im69.gulfup.com/gBZHK.png

所以在上面的示例数据中，我说我选择标准为胖

我正在寻找自动过滤器返回第1行和第2;如果我选择标准为有趣，我需要行2& 6等等....

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

  With Sheet1 
 .AutoFilterMode = False 
 
使用.Range（A1：D6）
 .AutoFilter 
 .AutoFilter字段：= 2，Criteria1：=Fat，Operator：= xlFilterValues 
 .AutoFilter字段：= 3，Criteria1 ：=Fat，运算符：= xlFilterValues 
 .AutoFilter字段：= 4，Criteria1：=Fat，运算符：= xlFilterValues 
结束
结束
  

我还试图使用 Operator：= xlor 但是当我跑代码返回没有结果。

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

帮助是绝对赞赏的。

解决方案

您的方式。

使用带有公式的其他列：

  Dim copyFrom As Range 
 
与Sheet1 
 .AutoFilterMode = False 
 
与.Range（A1：E6）
'应用公式在列E 
 .Columns（。 Columns.Count）.Formula == OR（B1 =Fat，C1 =Fat，D1 =Fat）
 .AutoFilter字段：= 5，Criteria1：= True 
 
错误恢复下一步
设置copyFrom = .Offset（1）.Resize（.Rows.count  -  1）.SpecialCells（xlCellTypeVisible）
错误GoTo 0 
结束
结束
 
如果不是CopyFrom是没有然后copyFrom.EntireRow.Copy 
  

使用联盟的For循环：

  Dim copyFrom As Range 
 Dim i As Long 
 
 With Sheet1 
 For i = 2 To 6 
如果.Range（B& i）=FatOr .Range（C& i）=FatOr .Range（D& i）=Fat然后
如果copyFrom是Nothing然后
设置copyFrom = .Range（B& i）
 Else 
设置copyFrom = Union（.Range（B& i），copyFrom）
 End If 
结束如果
下一个
结束
 
如果没有copyFrom是没有，然后copyFrom.EntireRow.Copy 
  

对于复制标题：

  Dim copyFrom As Range 
 Dim i As Long 
 
 With Sheet1 
设置copyFrom = .Range（B1）
对于i = 2至6 
如果.Range（B& i ）=FatOr .Range（C& i）=FatOr .Range（D& i）=Fat然后
设置copyFrom = Union（.Range & i），copyFrom）
 End If 
 Next 
结束
 
 copyFrom.EntireRow.Copy 
  / pre> 
 
 
 
 
 
 
 
 
 更新： p> 
 
 
  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 
如果没有（.Range（B& ; i）=FatOr .Range（C& i）=FatOr .Range（D& i）=Fat）然后
如果hideRng是Nothing然后
设置hideRng = .Range（B& i）
 Else 
设置hideRng = Union（.Range（B& i），hideRng）
 End If 
结束如果
下一个
如果不是hideRng是没有，然后hideRng.EntireRow.Hidden = True 
 
在错误恢复下一个
设置copyRng = .Range（B1： B& lastrow）.SpecialCells（xlCellTypeVisible）
错误GoTo 0 
结束
 
如果copyRng不是，然后
 MsgBox没有符合条件的行 - 没有什么可以复制
退出Sub 
 Else 
 copyRng.EntireRow.Copy 
如果
  
  
 
I need to filter a data table where 3 columns can contain the result I am looking for:

So if the criteria is found in columns 1, 2 or 3 then the row should be returned.

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

So in the above sample data lets say I select the criteria as "Fat"

I am looking for the autofilter to return rows 1 & 2; if I select the criteria as "Funny" I need rows 2 & 6 and so on....

Below is my code which is not working since apparently it tries to find the rows in which all columns contain the criteria, and it is not what I am looking to do.
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
I have also tried to use Operator:=xlor but when I ran the code it returned no results.

In short: The row must be returned by the filter is the criteria is found in column B or C or D.

Help is definitely appreciated.
解决方案
As follow up from comments, there are two ways for you.

Use additional column with formula:
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
Use For loop with Union:
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
For copying also header:
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






UPDATE:
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


                        
这篇关于自动过滤器在多列Excel VBA的文章就介绍到这了，希望我们推荐的答案对大家有所帮助，也希望大家多多支持IT屋！