VBA查找用户输入值时二次未找到崩溃问题求助

我编写了如下Macro4宏用于批量处理记录：首次未找到输入的账号时，程序会弹出“not found”提示框且正常运行，但第二次未找到对应值时，程序直接崩溃停止运行。请问为何会出现这种情况？

原代码：

Sub Macro4()

On Error GoTo errmsg

errmsg:

MsgBox "not found"

Do While MsgBox("Do you have after sales applications?", vbYesNo) = vbYes

    Cells.Find(What:=InputBox("Please input Full Account Number"), After:=ActiveCell, LookIn:=xlFormulas _
        , LookAt:=xlWhole, SearchOrder:=xlByRows, SearchDirection:=xlNext, _
        MatchCase:=False, SearchFormat:=False).Select

    Selection.EntireRow.Select

    Selection.Copy

    Sheets("Sheet1").Select

    Range("A1").Insert 

    Sheets("ELEC").Select

    ActiveCell.EntireRow.Delete Shift:=xlUp

    Application.CutCopyMode = False

    On Error GoTo errmsg

Loop


        Sheets("Sheet1").Select

        Columns("R:R").Select

        Selection.Replace What:="N", Replacement:="R", LookAt:= _
        xlPart, SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:=False, _
        ReplaceFormat:=False

     finalRow = Cells(Rows.Count, "B").End(xlUp).Row

    Range(Cells(1, "B"), Cells(finalRow, "B")).EntireRow.Select

    Selection.Cut

    Sheets("ELEC").Select

    Rows("7:7").Insert

End Sub

崩溃原因分析 #

1. 错误处理逻辑顺序错误：代码开头直接执行errmsg:标签后的MsgBox "not found"，且首次触发错误后，错误捕获状态没有重置——第二次错误发生时，错误处理机制已经失效，导致程序直接崩溃。
2. 空对象调用错误：当Cells.Find找不到目标时返回Nothing，此时调用.Select会触发运行时错误；而第一次错误处理后，没有恢复正常的代码执行流程，后续错误无法被捕获。
3. 依赖Select/Selection的风险：频繁使用单元格选择操作，不仅降低代码效率，还容易因当前活动单元格/工作表变化引发意外错误。

修复后的代码 #

Sub Macro4()
    Dim foundCell As Range
    Dim userInput As String
    
    Do While MsgBox("Do you have after sales applications?", vbYesNo) = vbYes
        userInput = InputBox("Please input Full Account Number")
        If userInput = "" Then Exit Sub ' 处理空输入
        
        ' 直接查找并判断结果，避免触发错误
        Set foundCell = Cells.Find(What:=userInput, _
                                    After:=ActiveCell, _
                                    LookIn:=xlFormulas, _
                                    LookAt:=xlWhole, _
                                    SearchOrder:=xlByRows, _
                                    SearchDirection:=xlNext, _
                                    MatchCase:=False, _
                                    SearchFormat:=False)
        
        If Not foundCell Is Nothing Then
            ' 移除Select操作，直接通过对象操作单元格
            foundCell.EntireRow.Copy
            Sheets("Sheet1").Range("A1").Insert
            foundCell.EntireRow.Delete Shift:=xlUp
            Application.CutCopyMode = False
        Else
            MsgBox "not found"
        End If
    Loop

    ' 后续批量处理代码，同样移除Select操作
    With Sheets("Sheet1")
        .Columns("R:R").Replace What:="N", _
                                Replacement:="R", _
                                LookAt:=xlPart, _
                                SearchOrder:=xlByRows, _
                                MatchCase:=False
                                
        finalRow = .Cells(.Rows.Count, "B").End(xlUp).Row
        .Range(.Cells(1, "B"), .Cells(finalRow, "B")).EntireRow.Cut
    End With
    
    Sheets("ELEC").Rows("7:7").Insert
End Sub

关键修改点 #

1. 移除错误捕获依赖：直接判断foundCell是否为Nothing，从根源避免错误触发，比依赖On Error更可靠。
2. 取消Select操作：通过对象引用直接操作单元格和工作表，消除因活动对象变化引发的错误，同时提升代码执行效率。
3. 添加空输入处理：避免用户取消输入时引发后续逻辑错误。
4. 优化流程控制：确保每次循环的查找逻辑独立，不会因前一次的错误状态影响后续执行。

内容的提问来源于stack exchange，提问作者Ahmed Salamony