エクセルVBAの検索複数の条件

Question

は、このコードは、私が見て、複数の条件で動作するように修正された映像から来た

Sub finddata() 
    Dim nursenumber As String 
    Dim finalrow As Integer 
    Dim i As Integer 
    Dim course As Integer 
    Dim nurserow As Integer 

    nursenumber = InputBox("please enter nurse number") 
    nurserow = InputBox("please enter nurse row") 
    finalrow = Sheets("S1").Range("A10000").End(xlUp).Row 
    course = ADORIE 

    'fire update 
    For i = 2 To finalrow 
     Worksheets("S1").Activate 
     If Cells(i, 1) = nursenumber & Cells(i, 7) = "FIRE" Then 
      Cells(i, 9).Copy 
      Worksheets("database").Activate 
      Cells(nurserow, 2).PasteSpecial 
     End If 

     'cpr 
     If Cells(i, 1) = nursenumber & Cells(i, 7) = "CPRNURL4" Or _ 
      Cells(i, 7) = "BUCPRBYS" Or Cells(i, 7) = "BUCPREMS" Or _ 
      Cells(i, 7) = "CPRACLSR" Or Cells(i, 7) = "CPRADULT" Or _ 
      Cells(i, 7) = "CPRALIED" Or Cells(i, 7) = "CPRBASIC" Or _ 
      Cells(i, 7) = "CPRBYST" Or Cells(i, 7) = "CPRCO567" Or _ 
      Cells(i, 7) = "CPRMANHA" Or Cells(i, 7) = "CPRMCORP" Or _ 
      Cells(i, 7) = "CPRNURL4" Then 

      Cells(i, 9).Copy 
      Worksheets("database").Activate 
      Cells(nurserow, 3).PasteSpecial 

    Next i 
End Sub 

Answer 1

上記の私のコメントに続いて、Orの代わりにSelect Caseのコードが叫んでいます。

コード

Sub finddata() 

Dim nursenumber As String 
Dim finalrow As Integer 
Dim i As Integer 
Dim course As Integer 
Dim nurserow As Integer 

nursenumber = InputBox("please enter nurse number") 
nurserow = InputBox("please enter nurse row") 
finalrow = Sheets("S1").Range("A10000").End(xlUp).Row 
course = ADORIE 

With Worksheets("S1") 
    For i = 2 To finalrow 
     If .Cells(i, 1) = nursenumber Then 
      Select Case .Cells(i, 7).Value 
       Case "FIRE" 
        .Cells(i, 9).Copy Destination:=Worksheets("database").Cells(nurserow, 2) 

       Case "CPRNURL4", "BUCPRBYS", "CPRACLSR", "CPRADULT", "CPRALIED", "CPRBASIC", "CPRBYST", "CPRCO567", "CPRMANHA", "CPRMCORP", "CPRNURL4" 
        .Cells(i, 9).Copy Destination:=Worksheets("database").Cells(nurserow, 3) 

      End Select 
     End If 
    Next i 
End With 

End Sub