excel vba搜索多个标准

Question

when I run this VBA macro I get the same result despite putting in different nurse id thanks, this code came from a video that I watch and has been modified to work with multiple criteria

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

Following my comments above, also, your code is screaming for a Select Case instead of your multiple Or .

Code

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