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

Question

我想知道是否有人有任何经验对代码段施加时间限制。我已经将一个搜索引擎编程到了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 

Answer 1

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

在论文的情况下，通过比较至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