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

有没有办法在VBA中强加代码的时间限制？

1 个答案: