有沒有辦法對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