如何使用 Excel VBA 过滤 2 列中的 1 个条件?

声明:本页面是StackOverFlow热门问题的中英对照翻译,遵循CC BY-SA 4.0协议,如果您需要使用它,必须同样遵循CC BY-SA许可,注明原文地址和作者信息,同时你必须将它归于原作者(不是我):StackOverFlow 原文地址: http://stackoverflow.com/questions/12014529/
Warning: these are provided under cc-by-sa 4.0 license. You are free to use/share it, But you must attribute it to the original authors (not me): StackOverFlow

提示:将鼠标放在中文语句上可以显示对应的英文。显示中英文
时间:2020-09-11 17:21:40  来源:igfitidea点击:

How do I use Excel VBA to filter 1 criteria across 2 columns?

excelvbaexcel-vba

提问by phan

I have 2 columns of childrens' names in Column A and Column B. They represent pairs of children who have worked together.

我在 A 列和 B 列中有 2 列孩子的名字。它们代表一起工作的成对的孩子。

I want to filter for all rows where "Bob" has worked with any other kid. So I want to filter for all rows for which 1 criteria (Bob) shows up in either Column A OR Column B.

我想过滤“鲍勃”与任何其他孩子一起工作的所有行。所以我想过滤出在 A 列或 B 列中出现 1 个条件 (Bob) 的所有行。

I want to put these rows, or pairs of kids, into an array. How do I do this?

我想将这些行或成对的孩子放入一个数组中。我该怎么做呢?

回答by Siddharth Rout

I haven't seen Doug's answer on Union of Ranges. But here is an example. This uses Autofilterinstead of looping through ranges. I have commented the code so you should not have problem understanding it.

我还没有看到道格对范围联盟的回答。但这里有一个例子。这使用Autofilter而不是循环遍历范围。我已经对代码进行了注释,因此您理解它应该不会有问题。

CODE

代码

Sub Sample()
    Dim ws As Worksheet
    Dim rng As Range, rngA As Range, rngB As Range
    Dim Lrow As Long

    Set ws = Sheets("Sheet1")

    With ws
        '~~> Get last row of Col A
        Lrow = .Range("A" & .Rows.Count).End(xlUp).Row

        '~~> Identify the range
        Set rng = .Range("A1:B" & Lrow)

        .AutoFilterMode = False

        '~~> Identify the range in Col A Which has BOB
        With rng
            .AutoFilter Field:=1, Criteria1:="Bob"
            Set rngA = .Offset(1, 0).SpecialCells(xlCellTypeVisible)
        End With

        .AutoFilterMode = False

        '~~> Identify the range in Col B Which has BOB
        With rng
            .AutoFilter Field:=2, Criteria1:="Bob"
            Set rngB = .Offset(1, 0).SpecialCells(xlCellTypeVisible)
        End With

        .AutoFilterMode = False

        '~~> Hide All except the Header row
        rng.Offset(1, 0).EntireRow.Hidden = True
        '~~> Unhide the rows which have Bob
        Union(rngA, rngB).EntireRow.Hidden = False
    End With
End Sub

SCREENSHOT

截屏

enter image description here

enter image description here

回答by Jon Crowell

Try the following code. It creates a scratch pad sheet, copies any row that has Bob in either column, creates an array from the results, and then deletes the scratchpad.

试试下面的代码。它创建一个便笺簿,复制任一列中包含 Bob 的任何行,根据结果创建一个数组,然后删除便笺簿。

Sub GetBobRows()
    Dim src As Worksheet
    Dim tgt As Worksheet
    Dim rng As Range
    Dim cell As Range
    Dim lastRow As Long
    Dim bobCount As Long
    Dim bobRow As Long

    Set src = ActiveSheet
    Sheets.Add
    ActiveSheet.Name = "Scratchpad"
    Set tgt = ActiveSheet

    ' assumes two columns with Bob data are A and B and start in row 1
    ' of the activesheet
    lastRow = src.Range("A" & src.Rows.Count).End(xlUp).Row

    Set rng = src.Range("A1:A" & lastRow)
    bobCount = 1

    For Each cell In rng
        If cell.Value = "Bob" Or cell.Offset(, 1).Value = "Bob" Then
            bobRow = cell.Row
            tgt.Range("A" & bobCount & ":B" & bobCount).Value = _
                src.Range("A" & bobRow & ":B" & bobRow).Value
            bobCount = bobCount + 1
        End If
    Next
    Call CreateBobArray(tgt)
    DeleteScratchpad
End Sub

Sub CreateBobArray(tgt As Worksheet)
    Dim vaBobs As Variant
    Dim lRow As Long

    lRow = tgt.Range("A" & tgt.Rows.Count).End(xlUp).Row

    'Read the data from the scratch pad into the bob array
    vaBobs = tgt.Range("A1:B" & lRow).Value
End Sub

Sub DeleteScratchpad()
    Application.DisplayAlerts = False
        Sheets("Scratchpad").Delete
    Application.DisplayAlerts = True
End Sub