Question

此代码允许您在一个表格中更改一个值，然后在另一个范围内查找原始值（＆＃39;旧代码＆＃39;），如果其中有一个或多个匹配项＆＃39;其他范围＆＃39;，它用newcode替换所有旧代码。

当从新代码中删除字符时，这非常有效，但是，当向新代码添加一个字符时，循环永远不会停止。例如，如果当前（旧代码）是＆＃34;测试＆＃34;，并且我键入＆＃34; tes＆＃34;，代码将触发，并且所有＆＃34;测试＆＃34;改为＆＃34; tes＆＃34;。如果我改变＆＃34;测试＆＃34;到＆＃34;测试1＆＃34;，所有都改为＆＃34;测试1＆＃34;，但是循环继续运行，即使C在所有改变之后都没有。如果在do内似乎没有帮助。

我还应该提到oldcode不是直接＆＃34;测试＆＃34;，Oldcode实际上来自第1列，在那里它连接＆＃34; test＆＃34;并计算其中有多少，所以＆＃34; test-1＆＃34;。

非常感谢任何帮助！

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

Answer 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

VBA-在循环中向.findnext添加字符并不会退出循环

1 个答案: