excel vbaを使用して複数の値を検索

Question

以下のコードは、セルK8に入力された値を検索し、その値を返すのに役立ちます。私は複数の値を検索するのに助けが必要で、範囲K8:K30に入力したすべての値を検索する必要があり、それらに関連するレコードを表示する必要があります。

Sub finddata() 
    Dim emstring As String 

    Dim finalrow As Integer 
    Dim i As Integer 

    Sheets("Sheet1").Range("P3:X37").ClearContents 

    emstring = Sheets("sheet1").Range("K8").Value 
    finalrow = Sheets("Sheet1").Range("A6000").End(xlUp).Row 

    For i = 2 To finalrow 
     If Cells(i, 2) = emstring Then 
      Range(Cells(i, 1), Cells(i, 3)).Copy 
      Range("P6000").End(xlUp).Offset(1, 0).PasteSpecial xlPasteFormulasAndNumberFormats 
     End If 
    Next i 
End Sub 

Answer 1

ここに行く、余分な長さをチェックしてループのためにネスト：xlFilterValuesに設定されOperator引数で

Sub finddata() 
    Dim emstring As String 

    Dim finalrow As Integer 
    Dim i As Integer 

    Sheets("Sheet1").Range("P3:X37").ClearContents 

    emstring = Sheets("sheet1").Range("K8").Value 
    finalrow = Sheets("Sheet1").Range("A6000").End(xlUp).Row 

    Dim ctrSearchRow As Integer 

     For i = 2 To finalrow 
      For ctrSearchRow = 8 To 30 
       emstring = Sheets("Sheet1").Cells(ctrSearchRow, 11).Value 
       If Len(emstring) > 0 Then 
        If StrComp(Cells(i, 2).Value, emstring, vbTextCompare) = 0 Then 
         Range(Cells(i, 1), Cells(i, 3)).Copy 
         Range("P6000").End(xlUp).Offset(1, 0).PasteSpecial xlPasteFormulasAndNumberFormats 
        End If 
       End If 
      Next ctrSearchRow 
     Next i 
End Sub 

Answer 2

AutoFilter()使用は、ここで手に助けを与えることができます。

Sub finddata() 
    With Sheets("Sheet1") 
     .Range("P3:X37").ClearContents 
     With .Range("B1", .Cells(.Rows.count, 2).End(xlUp)) '<--| reference column "B" range from row 1 (header) down to last not empty row 
      .AutoFilter field:=1, Criteria1:=Application.Transpose(.Parent.Range("K8:K30").Value), Operator:=xlFilterValues '<--| filter on all K8:K30 values 
      If Application.WorksheetFunction.Subtotal(103, .Cells) > 1 Then '<--| if any filtered cell found 
       .Offset(1, -1).Resize(.Rows.count - 1, 3).SpecialCells(xlCellTypeVisible).Copy '<-- copy filtered range offsetted one column to the right and resized to three columns 
       .Parent.Cells(.Rows.count, "P").End(xlUp).Offset(1, 0).PasteSpecial xlPasteFormulasAndNumberFormats '<--| paste special 
      End If 
     End With 
     .AutoFilterMode = False 
    End With 
End Sub 

を