VBA-добавление символа .findnext в цикле не выходит из цикла

Этот код позволяет вам изменить значение в одной таблице, затем ищет исходное значение(‘oldcode’) в другом диапазоне, если есть один или несколько вхождений в ‘другом диапазоне’, он заменяет весь старый код новым.

Это прекрасно работает при удалении символов из newcode, однако, при добавлении даже одного символа в newcode, цикл никогда не останавливается. Например, если current (oldcode) является «Test», и я набираю «tes», код срабатывает, и все «test» изменяются на «tes». Если я изменю «Test» на «Test 1», все будут изменены на «Test 1», но цикл продолжает работать, даже если C ничего после того, как все изменены. Кажется, что if внутри do не помогает.

Я должен также упомянуть, что oldcode не является непосредственно «тестом», Oldcode на самом деле происходит из столбца 1, где он сцепляет» тест «и подсчитывает, сколько их там, поэтому»тест-1».

Любая помощь будет очень признательна!

Private Sub worksheet_change(ByVal target As Range)

Dim row As Integer
Dim column As Integer
Dim i As Integer
Dim oldcode As String
Dim newcode As String
Dim IssueLogSheet As Worksheet
Dim FailureModeTable As Range
Dim max As Integer


Set IssueLogSheet = Sheets("Issue Log")
Set FailureModeTable = IssueLogSheet.Range("FMCODE")

row = target.row
column = target.column



    If Not Intersect(target, FailureModeTable) Is Nothing And (target.column <> 1 Or target.column <> 4) Then


        Application.EnableEvents = False
        Application.Undo
        oldcode = Cells(row, 1).Value
        oldcode = WorksheetFunction.Proper(oldcode)
        Application.Undo
        Application.EnableEvents = True
        MsgBox oldcode


            With IssueLogSheet.Range("IssueLogFailureName")
            Set c = .Find(oldcode, LookIn:=xlValues)

                If Not c Is Nothing Then
                newcode = Cells(row, 1).Value
                newcode = WorksheetFunction.Proper(newcode)


                    Do
                      If c Is Nothing Then
                      Exit do
                      End If
                    c.Value = newcode
                    Set c = .FindNext(c)
                    Loop While Not c Is Nothing


                End If

          End With

      End If

End Sub

1 ответ

  1. добавлять

    Dim firstAddress As String
    

    и измените цикл следующим образом:

        With IssueLogSheet.Range("IssueLogFailureName")
            Set c = .Find(oldcode, LookIn:=xlValues)
    
            If Not c Is Nothing Then
                firstAddress = c.Address '<--| store first occurrence address
                newcode = WorksheetFunction.Proper(Cells(row, 1).Value)
                Do
                    c.Value = newcode
                    Set c = .FindNext(c)
                Loop While Not c Is Nothing And c.Address <> firstAddress '<--| exit should 'Find()' wrap back to first occurrence
            End If
        End With
    

    в противном случае просто измените цикл следующим образом

        With IssueLogSheet.Range("IssueLogFailureName")
            Set c = .Find(oldcode, LookIn:=xlValues, lookat:=xlWhole) '<--| impose a full match
    
            If Not c Is Nothing Then
                newcode = WorksheetFunction.Proper(Cells(row, 1).Value)
                Do
                    c.Value = newcode
                    Set c = .FindNext(c)
                Loop While Not c Is Nothing
            End If
        End With