Application.Wait打破我的代码

Question

  

原始

我有以下代码为单元格着色以演示使用毫秒等待时间。但是，当struct s1*代码中断时。我得到的错误是i = 500，从500到1000我必须继续点击继续。我试图将我的代码包装在Code Execution has been Interrupted和Application.DisplayAlerts = False中，但它仍然会被中断并且无法完成。我估计，当True接近i时，此代码大约需要6分钟左右。我不知道是什么原因引起的。我已经完成了我能想到的每一个环境，并且不会在没有破坏的情况下继续超过500。 ms是根据1000计算的。

  

Excel 2007

1/(1000*24*60*60)

提前谢谢！

  

更新

@MarcoMarc提供的链接（stackoverflow.com/a/5823507/5175942）解决了我的问题的最初突破问题。但是，它似乎仍然没有正确递增。它似乎没有等到Sub Kaleidoscope() Dim r, g, b, i As Integer, ms As Double ms = 0.0000000115741 For i = 1 To 1000 r = WorksheetFunction.RandBetween(1, 255) g = WorksheetFunction.RandBetween(1, 255) b = WorksheetFunction.RandBetween(1, 255) Range("A1").Interior.Color = RGB(r, g, b) Application.Wait (Now + (ms * i)) Next i End Sub 然后每次似乎停止1秒。这是你说的限制，最终不可能等待1毫秒？不需要修改原始代码就可以防止破坏。

  

最后的想法

@JohnMuggins对原始代码进行了很好的调整，并提供了额外的工具来查看幕后的计算。但是，Ultimatley还必须像@MacroMarc一样调用winAPI，以便暂停代码不到1秒。通过对其他网站和Stack Overflow的研究，似乎不可能仅使用VBA暂停程序不到1秒。它或者以正常速度运行，或者当它达到500毫秒时，它会向上舍入到1秒，并将代码延迟1秒而不是500毫秒。我最后的演示代码是@JohnMuggins的调整。

i = 500

Answer 1

您可以使用winAPI中的Sleep功能。

在模块的顶部：

Declare Sub Sleep Lib "kernel32" (ByVal dwMilliseconds As Long)

然后在你的代码中：

Sleep i ' where i is now in milliseconds

请注意，Sleep会延迟所有VBA代码。

Answer 2

0m3r是正确的。问题在于application.wait函数。请尝试以下do events例程。

Sub Kaleidoscope()
Dim r, g, b, i As Integer, ms As Double

ms = 0.0000000115741
For i = 1 To 1000
    r = WorksheetFunction.RandBetween(1, 255)
    g = WorksheetFunction.RandBetween(1, 255)
    b = WorksheetFunction.RandBetween(1, 255)
    Range("A1").Interior.Color = RGB(r, g, b)
    Range("A1").Value = i
    For j = Now To (Now + (ms * i))
        DoEvents
    Next j

Next i

End Sub

Answer 3

这是我达到运行时间2分9秒的唯一方法。

Declare Sub Sleep Lib "kernel32" (ByVal dwMilliseconds As Long)

'   run time on my computer 2:09:07
'   runs from 6 ms to 751.5 ms
Sub ewhgfsd()
Dim StartTime As Double
Dim EndTime As Double

StartTime = Timer

For i = 1 To 500
    ms = ms + (i * 0.006)
    r = WorksheetFunction.RandBetween(1, 255)
    g = WorksheetFunction.RandBetween(1, 255)
    b = WorksheetFunction.RandBetween(1, 255)
    Range("A1").Interior.Color = RGB(r, g, b)
    Sleep ms
    Range("B1").Value = "Time: " & Format(Timer - StartTime, "####.##")
    Range("C1").Value = "ms =  " & Format(ms, "####.#####")
    Range("D1").Value = i & " of 500"
Next i

EndTime = Timer - StartTime
Debug.Print Format(EndTime, "####.##")
End Sub