Question

当我单击用户表单上的按钮时，即使它突出显示第一个实例，excel冻结并且长时间没有响应，也会运行此查找和突出显示vba。没有显示任何错误等。

     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

Excel在执行vba期间冻结

3 个答案:

分辨率：

未来提示：