有没有一种方法可以对VBA中的代码施加时间限制? [英] Is there a way to impose a time limit for the code in VBA?
问题描述
我想知道是否有人对代码段施加时间限制有任何经验.我已将搜索引擎编程为VBA中的excel电子表格,并且其中的代码部分删除了重复的结果.现在,如果给出最模糊的搜索条件,这部分内容有时可能会持续很长时间.因此,我想为此操作设置一个时间限制.我到处都在寻找解决方案并尝试使用OnTime,但是它似乎无法按照我需要的方式工作.理想情况下,我希望强加时间限制,然后在到达GoTo语句时将其进一步移入代码中.根据我的阅读,OnTime不会中断操作,而是会等它完成,这不是我想要的.
I was wondering if anyone had any experience imposing time limits on sections of code. I have programmed a search engine into an excel spreadsheet in VBA and there is a section of the code that removes duplicate results. Now this part can sometimes stretch on for quite a long time if given the most vague search criteria. So I would like to impose a time limit for this operation. I have looked everywhere for a solution and tried using OnTime, but it doesnt seem to work in the way I need. Ideally, I'd like an imposed time limit and then when that is reached a GoTo statement, to move it further on in the code. From what I have read the OnTime will not interrupt an operation, but will wait for it to finish instead, this is not what I want.
感谢您的帮助. 艾米
我已经添加了代码:
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
等
I assume your code must have some kind of loop, e.g. For Each
, While ... Wend
, Do ... Loop Until
, etc.
在这些情况下,通过与Timer
进行比较来扩展条件.这将返回0到86400之间的Double,表示自午夜以来经过了几秒钟.因此,您还需要考虑休息时间.这是一些示例代码,向您展示了三种不同循环结构的实现:
In theses cases, extend the condition by a comparison to the Timer
. This returns you a Double between 0 and 86400, indicating how many seconds have passed since midnight. Thus, you also need to account for the day break. Here is some example code showing you implementations for three different loop constructs:
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
这篇关于有没有一种方法可以对VBA中的代码施加时间限制?的文章就介绍到这了,希望我们推荐的答案对大家有所帮助,也希望大家多多支持IT屋!