如何使用Excel VBA跨2列過濾1個條件？

Question

我在A列和B列中有兩列兒童名字。他們代表一對一起工作過的孩子。

我想過濾“Bob”與其他孩子一起工作的所有行。 所以我想過濾所有行，其中1個標准（Bob）顯示在A列或B列中。

我想將這些行或一對孩子放入一個數組中。 我該怎么做呢？

Answer 1

我還沒有看到道格在聯盟范圍內的回答。 但這是一個例子。 這使用Autofilter而不是循環范圍。 我已對代碼進行了評論，因此您不應該對它有所了解。

碼

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

屏幕截圖

Answer 2

請嘗試以下代碼。 它會創建一個便箋本表，復制任何列中包含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