Excel VBA를 사용하여 2 개의 열에서 1 개의 조건을 필터링하려면 어떻게합니까?

Question

나는 열 A와 열 B에 자녀 이름의 2 열을 가지고 있습니다. 그들은 함께 일한 자녀 쌍을 나타냅니다.

"Bob"이 다른 아이와 함께 작업 한 모든 행을 필터링하려고합니다. 그래서 하나의 기준 (Bob)이 Column A 또는 Column B 중 하나에 나타나는 모든 행을 필터링하려고합니다.

이 행 또는 키 쌍을 배열에 넣으 려합니다. 어떻게해야합니까?

Answer 1

나는 Union of Ranges에서 Doug의 대답을 보지 못했습니다. 그러나 여기에 예제가 있습니다. 범위를 루핑하는 대신 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

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