有没有办法对VBA中的代码施加时间限制？

我想知道是否有人有对代码段施加时间限制的经验。我已经用 VBA 将搜索引擎编程到 Excel 电子表格中，并且有一段代码可以删除重复的结果。现在，如果给出最模糊的搜索条件，这部分有时可能会持续相当长的时间。所以我想对这个操作施加一个时间限制。我到处寻找解决方案并尝试使用 OnTime，但它似乎没有按照我需要的方式工作。理想情况下，我想要一个强加的时间限制，然后当达到 GoTo 语句时，将其在代码中进一步移动。根据我的阅读，OnTime 不会中断操作，而是会等待它完成，这不是我想要的。

谢谢你们的帮助。 艾米

我添加了我的代码：

Sub RemoveDuplicates()
Application.ScreenUpdating = False
Application.Calculation = xlCalculationManual
Application.EnableEvents = False
'Code called upon through the other macros which will remove duplicates from all the   types of search.
Application.StatusBar = "Removing Duplicates...."

Dim k As Integer
Dim SuperArray As String
Dim CheckingArray As String
Dim Duplicate As Boolean
Dim i As Integer
Dim j As Integer
Dim m As Integer
Dim Endrow As Integer
Dim Endcolumn As Integer
Dim w As Integer
Dim x As Integer
Dim n As Integer

w = 1
x = 9

Endcolumn = Module6.Endcolumn(x)
Endrow = Module6.Endrow(w)

If Worksheets("Search Engine").Cells(9, Endrow) = "Percentage Similarity" Then
    Endrow = Endrow - 1
End If

    For i = 9 To Endcolumn

        j = 1
        k = i + 1

        Do While j <> Endrow + 1
            SuperArray = Cells(i, j) & Superstring
            Superstring = SuperArray
            j = j + 1
        Loop

        For k = k To Endcolumn
            m = 1
            Do While m <> Endrow
                CheckingArray = Cells(k, m) & Uberstring
                Uberstring = CheckingArray
                m = m + 1
            Loop
            If Uberstring = Superstring Then
            n = 1
                Do While n <> Endrow + 1
                If Worksheets("Search Engine").Cells(k, n).Interior.ColorIndex = 37 Then
                    Worksheets("Search Engine").Cells(i, n).Interior.ColorIndex = 37
                End If
                n = n + 1
                Loop
                Rows(k).Clear
            End If
            Uberstring = -1
        Next k
        Superstring = -1
    Next i


Do While i > 9
    If Cells(i, 1) = Empty Then
        Rows(i).Delete
    End If
    i = i - 1
Loop

End Sub

我假设你的代码必须有某种循环，例如For Each, While ... Wend, Do ... Loop Until, etc.

在这些情况下，通过与Timer。这将返回 0 到 86400 之间的 Double，指示自午夜以来已经过去了多少秒。因此，您还需要考虑黎明时间。下面是一些示例代码，向您展示了三种不同循环结构的实现：

Sub ExampleLoops()
    Dim dblStart As Double
    Dim tmp As Long

    Const cDblMaxTimeInSeconds As Double = 2.5

    dblStart = Timer

    'Example with For loop
    For tmp = 1 To 1000
        tmp = 1     'to fake a very long loop, replace with your code
        DoEvents    'your code here
        If TimerDiff(dblStart, Timer) > cDblMaxTimeInSeconds Then GoTo Finalize 'Alternative: Exit For
    Next

    'Alternative example for Do loop
    Do
        DoEvents 'your code here
    Loop Until TimerDiff(dblStart, Timer) > cDblMaxTimeInSeconds And False 'your condition here

    'Alternative example for While loop
    While TimerDiff(dblStart, Timer) <= cDblMaxTimeInSeconds And True 'your condtion here
        DoEvents 'your code here
    Wend

Finalize:
    'FinalizeCode here
    Exit Sub
End Sub

Function TimerDiff(dblTimerStart As Double, dblTimerEnd As Double)
    Dim dblTemp As Double
    dblTemp = dblTimerEnd - dblTimerStart
    If dblTemp < -43200 Then 'half a day
        dblTemp = dblTemp + 86400
    End If
    TimerDiff = dblTemp
End Function