使用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

在這裏你去，嵌套For循環以加長檢查：

其 Operator參數設置爲 xlFilterValues

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