有没有办法强加的时间限制在VBA代码？(Is there a way to impose a tim

我想知道如果任何人有任何的代码段强加时间限制的体验。 我已编辑的搜索引擎进入VBA Excel电子表格，并且存在删除重复的结果代码的一个部分。 现在，如果给予最模糊搜索标准这部分有时可以舒展上相当长的一段时间。 所以我想强加时间限制进行​​此项操作。 我到处找一个解决方案，使用准时尝试，但它似乎没有在我需要的方式工作。 理想情况下，我想强加时间限制，然后当达到GoTo语句，在代码中进一步上移动。 从我所读的导通时间不会中断操作，但会等待它，而不是结束，这不是我想要的。

感谢您的帮助球员。 艾米

我已经添加了我的代码：

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之间，说明多少秒是如何从午夜开始传递。 因此，你还需要考虑的一天休息。 这里是你展示了三种不同的循环结构实现的一些示例代码：

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

文章来源: Is there a way to impose a time limit for the code in VBA?