Excel在執行VBA期間凍結

Question

當我單擊用戶窗體上的按鈕時，此查找並突出顯示vba會運行，即使它突出顯示了第一個實例，excel也會凍結並且長時間沒有響應。 不顯示任何錯誤或此類。

     Private Sub changebutton_tp_Click()
     Dim sheet As Worksheet
     Dim table_list_obj As ListObject
     Dim table_obj_row As ListRow
     Set sheet = Sheets("TermGUI")


    Dim rng As Range


    Set rng = sheet.Cells.Find(What:=TermPage.wordfound_tp.Value,_
LookIn:xlValues, lookat:=xlWhole)

    If rng Is Nothing Then
        MsgBox ("Term Not Found")
    ElseIf IsEmpty(rng) Then
        MsgBox ("Term Not Found")
    ElseIf rng = "" Then
        MsgBox ("Term Not Found")
    Else
        With sheet.UsedRange
        If Not rng Is Nothing Then
            Do Until rng Is Nothing
                sheet.Cells.Find(What:=TermPage.wordfound_tp.Value,_
               LookIn:=xlValues, lookat:=xlWhole, MatchCase:=False).Activate
                With Selection.Interior
                    .ColorIndex = 6
                    .Pattern = xlSolid
                    .PatternColorIndex = xlAutomatic
                End With
            Loop
        End If
        End With
        Set rng = Nothing
        MsgBox ("Term Found and Highlighted")
    End If

End Sub

好的，我已經確定了無限循環，但是我要做的是找到所有與查詢匹配的術語並突出顯示它們。 沒有循環，它僅對一個實例起作用。

Answer 1

Do Until rng Is Nothing '// <~~ stop condition here will never be met
       sheet.Cells.Find(What:=TermPage.wordfound_tp.Value,_
       LookIn:=xlValues, lookat:=xlWhole, MatchCase:=False).Activate
        With Selection.Interior
            .ColorIndex = 6
            .Pattern = xlSolid
            .PatternColorIndex = xlAutomatic
        End With
Loop

---

對象rng永遠不會成為Nothing你的循環過程-因此這個代碼將無限循環。

也許像這樣會更好：

Do Until rng Is Nothing
        Set rng = Nothing
        Set rng = sheet.Cells.Find(What:=TermPage.wordfound_tp.Value,_
       LookIn:=xlValues, lookat:=xlWhole, MatchCase:=False)
        If Not rng Is Nothing Then
            With rng.Interior
                .ColorIndex = 6
                .Pattern = xlSolid
                .PatternColorIndex = xlAutomatic
            End With
        End If
        DoEvents '// <~~ IMPORTANT if you want to be able to break the loop manually.
    Loop

Answer 2

解析度：

因為這條線： Do Until rng Is Nothing

它可能不會停止正在 Nothing很快的任何時間。

未來提示：

• 請嘗試逐行F8或Shift + F8進行調試，以首先發現問題。
• 如果要防止在執行長代碼循環時凍結代碼，請在每個循環的末尾添加DoEvents 。 這將允許您使用Esc破壞代碼。

Answer 3

Private Sub changebutton_tp_Click()
Dim sheet As Worksheet
Dim table_list_obj As ListObject
Dim table_obj_row As ListRow
Set sheet = Sheets("TermGUI")
Dim cll As Range

Dim rng As Range


Set rng = sheet.Cells.Find(What:=TermPage.wordfound_tp.Value, LookIn:=xlValues, lookat:=xlWhole)

If rng Is Nothing Then
    MsgBox ("Term Not Found")
ElseIf IsEmpty(rng) Then
    MsgBox ("Term Not Found")
ElseIf rng = "" Then
    MsgBox ("Term Not Found")
Else
    With sheet.UsedRange
       For Each cll In Worksheets("TermGUI").Range("A1", "A100").Cells
            sheet.Cells.Find(What:=TermPage.wordfound_tp.Value, LookIn:=xlValues, lookat:=xlWhole, MatchCase:=False).Activate
            With Selection.Interior
                .ColorIndex = 6
                .Pattern = xlSolid
                .PatternColorIndex = xlAutomatic
            End With
        Next
    DoEvents
    End With
    MsgBox ("Term Found and Highlighted")
End If

End Sub