Не удалось получить свойство FindNext класса Range

Question

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

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

Невозможно получить свойство FindNext класса Range.

Зачем Find будь в порядке, но не FindNext?

Вот код:

Private Sub cmdDeleteA_Click()

'declare the variables

    Dim findvalue As Range
    Dim cDelete As VbMsgBoxResult
    Dim cNum As Integer
'error statement

    On Error GoTo errHandler:

'check for values

    If Reg1.Value = "" Or Reg4.Value = "" Then
        MsgBox "There is not data to delete"
        Exit Sub
    End If
'give the user a chance to change their mind

    cDelete = MsgBox("Are you sure that you want to delete this training", vbYesNo + vbDefaultButton2, "Are you sure????")
    If cDelete = vbYes Then

'the next few paragraphs until "Loop While.." was recently added
'set the search range and find the row (2 layers)

    Dim rgF As Range
    Set rgF = Sheet2.Range("F:F")


        Set findvalue = rgF.Find(What:=Reg4, LookIn:=xlValues, LookAt:=xlWhole)


        'If the ID doesn't exist, get out of there
        If findvalue Is Nothing Then
            Debug.Print "No one has that ID anymore"
            Exit Sub
        End If

       Do
        'delete the row that has the ID

        findvalue.EntireRow.Delete

        'find the next instance
        Set findvalue = rgF.FindNext(findvalue)
        Loop While Not findvalue Is Nothing

    End If

'clear the controls

    cNum = 9
    For x = 1 To cNum
        Me.Controls("Reg" & x).Value = ""
    Next

'run the filter

    AdvFilter
'add the values to the listbox
    lstLookUp.RowSource = ""
    lstLookUp.RowSource = "Staff_Filter"
'error block

    On Error GoTo 0
    Exit Sub

errHandler::

    MsgBox "An Error has Occurred  " & vbCrLf & "The error number is:  " _
           & Err.Number & vbCrLf & Err.Description & vbCrLf & _
           "Please notify the administrator"

End Sub

Answer 1

Вместо того, чтобы проходить по каждой ячейке в диапазоне, просто используйте цикл Do...Loop While и выйдите из цикла, как только findValue будет Nothing.

Dim rgF As Range
Set rgF = Sheet2.Columns("F")

Do
    Set findValue = rgF.Find(what:=Reg4, LookIn:=xlValues, lookat:=xlWhole)
    If Not findValue Is Nothing Then findValue.EntireRow.Delete
Loop While Not findValue Is Nothing

Answer 2

Ваша проблема связана с тем, что вы удаляете findvalue , но пытаетесь использовать его в качестве аргумента After: = findvalue с вызовом FindNext.После удаления строки, содержащей findvalue , она больше не доступна для справки.

Вы можете продолжать удалять строки, но последующие вызовы должны быть Range.Find, а не Range.FindNext.

   Set findvalue = rgF.Find(What:=Reg4, LookIn:=xlValues, LookAt:=xlWhole)

   'if the ID doesn't exist, get out of there
   If findvalue Is Nothing Then
       Debug.Print "No one has that ID anymore"
       Exit Sub
   End If

   Do
       'delete the row that has the ID
        findvalue.EntireRow.Delete

        Set findvalue = rgF.Find(What:=Reg4, LookIn:=xlValues, LookAt:=xlWhole)
    Loop While Not findvalue Is Nothing

Поочередно соберите все диапазоны Find / FindNext в объединение и удалите их все сразу после их сбора.

    Dim rgF As Range, allFound As Range, addr As String
    Set rgF = Sheet2.Range("F:F")

    Set findvalue = rgF.Find(What:=Reg4, LookIn:=xlValues, LookAt:=xlWhole)

    If findvalue Is Nothing Then
        'If the ID doesn't exist, get out of there
        Debug.Print "No one has that ID anymore"
        Exit Sub
    Else
        'there is at least one row to delete
        'store original range address
        addr = findvalue.Address(0, 0)
        'seed the union oof ranges
        Set allFound = findvalue
        Do
            'collect into Union
            Set allFound = Union(findvalue, allFound)

            'find the next instance
            Set findvalue = rgF.FindNext(after:=findvalue)
        Loop Until findvalue.Address(0, 0) = addr

        'delete all row inthe union
        allFound.EntireRow.Delete
    End If

Answer 3

Лучшим способом для FIND() было бы использовать что-то вроде:

    Dim rgF As Range
    Set rgF = Sheet2.Range("F:F")

    For Each cll In rgF
        Set c = .Find(Reg4, LookIn:=xlValues)

        If c Is NOT Nothing Then
            ' Do whatever
        Next
    Next