Найдите каждую строку, соответствующую ключевому слову, затем вставьте все строки с найденным ключевым словом.

Question

Я пытаюсь найти каждый раз, когда имя человека находится в пределах диапазона, затем скопировать и вставить этот диапазон. Мой код работает только при первом обнаружении имени человека и копирует только эту строку вместо всех строк, в которых он находится. Пожалуйста, дайте мне знать, как отредактировать мой код, чтобы это исправить.

Private Sub CommandButton1_Click()

    Dim myValue As String
    myEmp = InputBox("Search for an employee by last name")
    ActiveSheet.Range("B2").Value = myEmp

    Dim lastrow As Long
    lastrow = Worksheets("Employee Reports").Range("A65536").End(xlUp).Row

    With Sheet7
        Dim rw As Range
        Set rw = .Range("B:B").Find(What:=myEmp, After:=.Range("B1"), _
        LookIn:=xlFormulas, LookAt:=xlWhole, SearchOrder:=xlByRows, _
        SearchDirection:=xlNext, MatchCase:=False, SearchFormat:=False)

        If Not rw Is Nothing Then
            rw.EntireRow.Copy Worksheets("Employee Reports").Cells(5, 1)
        Else
            MsgBox myEmp & "Employee Not Found"
        End If
    End With
End Sub

Answer 1

Попробуй это. Стандартный способ, который хорошо задокументирован, заключается в том, чтобы сохранить адрес первой найденной ячейки, а затем продолжать поиск следующего экземпляра, пока вы не вернетесь к исходному адресу.

Private Sub CommandButton1_Click()

Dim myValue As String, s As String, r As Long

myEmp = InputBox("Search for an employee by last name")
ActiveSheet.Range("B2").Value = myEmp 'better to specify sheet
r = 5

Dim lastrow As Long
lastrow = Worksheets("Employee Reports").Range("A" & Rows.Count).End(xlUp).Row 'don't hard-code the row number

With Sheet7 'would be better to stick to all names or all code names rather than mixing
    Dim rw As Range
    Set rw = .Range("B:B").Find(What:=myEmp, After:=.Range("B1"), LookIn:=xlFormulas, _
                                LookAt:=xlWhole, SearchOrder:=xlByRows, SearchDirection:=xlNext, _
                                MatchCase:=False, SearchFormat:=False)
    If Not rw Is Nothing Then
        s = rw.Address
        Do
            rw.EntireRow.Copy Worksheets("Employee Reports").Cells(r, 1)
            r = r + 1
            Set rw = .Range("B:B").FindNext(rw)
        Loop Until rw.Address = s
    Else
        MsgBox myEmp & "Employee Not Found"
    End If
End With

End Sub