有没有一种方法可以对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屋！