vba - Excel VBAを使用して2つの列にまたがる1つの条件をフィルタリングするにはどうすればよいですか？

Question

列Aと列Bに2列の子供の名前があります。これらは、一緒に働いた子供のペアを表しています。

「Bob」が他の子供と一緒に働いたすべての行をフィルタリングしたいと思います。したがって、1つの基準（Bob）が列Aまたは列Bのいずれかに表示されるすべての行をフィルター処理したいと思います。

これらの行、または子のペアを配列に入れたいと思います。どうすればよいですか？

Answer 1

UnionofRangesに関するDougの回答は見たことがありません。しかし、ここに例があります。これは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