Excel 应用程序。等待中断我的代码

原创的

我有下面的代码为一个单元格着色，以演示毫秒等待时间的使用。但是，当

i=500

时，代码中断。我得到的错误是

代码执行已被中断

，从500到1000，我必须继续单击“继续”。我试图将我的代码包装到

应用程序中。DisplayAlerts=False

和

True

，但它仍然会被中断，无法完成。我估计当

I

接近

1000

时，此代码大约需要6分钟左右。我不知道这是什么原因造成的。我已经经历了我能想到的每一个场景，它不会持续超过500而不被打破。根据

1/（1000*24*60*60）

计算ms

Excel 2007

提前谢谢你

更新

@MarcoMarc（stackoverflow.com/a/5823507/5175942）提供的链接解决了我问题的初始中断问题。但是，它似乎仍然没有正确地递增。它好像没有等到

i=500

，然后似乎每次都会暂停1秒。这是否就是您所说的限制，最终不可能等待1毫秒？不需要对原始代码进行任何更改来防止中断

最后的想法

@JohnMuggins对我的原始代码进行了很大的调整，并提供了额外的工具来查看场景后面的计算。不过最后通牒是，他还必须调用winAPI，比如@MacroMarc，以便将代码暂停不到1秒。通过对其他网站的研究和堆栈溢出，仅使用VBA似乎不可能将程序暂停不到1秒。它要么以正常速度运行，要么当达到500毫秒时，它会取整到1秒，并将代码延迟1秒，而不是500毫秒。我的最终演示代码如下所示，带有@JohnMuggins调整

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

Sub Kaleidascope()
Dim StartTime As Double
Dim EndTime As Double
Dim ms As Double
Dim i, r, g, b As Integer
Dim count As Long

StartTime = Timer

For i = 1 To 500
    ms = i
    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

0m3r是正确的。问题在于application.wait函数。请尝试以下“执行事件”例程。

---

这是我实现您的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

---

您可以使用winAPI中的Sleep函数

在模块顶部：

声明子睡眠库“kernel32”（ByVal-dwms长度相同）

然后在代码中：

Sleep i'我现在所在的位置（毫秒）

---

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

对于i=1到1000，请在

之后使用
DoEvents
查看这是否有帮助使用您的建议
对于i=1到1000 DoEvents…
它仍然在500处中断。我确实把它们放在了不同的行上。这一定和等待函数的限制有关。我使用了下面的代码，没有问题。Wait（现在是+（0.000001）），这可能是在循环期间中断执行的情况。我以前也遇到过这种情况。请尝试在错误弹出窗口中按Debug，然后按Ctrl-Break两次或两次以上。看到这个答案：
Now（）
似乎只精确到一秒钟。试着运行
Dim x作为Double:For i=1到10000:x=Now（）：Debug.Print i，x:Next
，您将看到显示的值跳转。我相信
Wait
也能在几秒钟内工作。我认为准确等待短时间的唯一方法是通过。这是一个创造性的解决方法，但最终无法完成我想要做的事情。我想通过允许代码比上一次执行的等待时间长1 ms来演示wait函数。这是在大约2秒钟内完成的，并没有显示我在寻找什么。然后它花了两倍于它应该花的时间。一秒钟只有1000毫秒。麦克弗利！！！麦克弗利！！！！顺便说一句，人眼只能捕捉到大约每30到60毫秒的颜色。我理解，但是如果你把每毫秒加上1，2，3，4，5，等等到500，那就是125250毫秒。这相当于125.25秒或2.09分钟。当
i>=500
将变化率与计时器进行比较时，它会在1秒时停止。John提供的答案在大约2秒或2000毫秒内完成了整个过程，小于计算时间的10%。我可能弄错了，所以如果我遗漏了某个关键点，请告诉我。
对于j=Now To（Now+（ms*I））
将在循环中每次递增一天，因此不会执行超过一次。我将
j存储为Double
，从
I=1运行到500
，并将代码计时为9秒。随着
i
变得越来越大，它仍然没有接近我预期的减速。我知道在很小的时间间隔内，这几乎是不可想象的，但在100+大关时，我预计会出现明显的减速。我能看到这个方法工作的唯一方法是确定
j
循环需要多少次，并且只需要1秒。然后，我可以逆向工程一个公式来模拟一毫秒，在这个时间范围内执行可能是数十万次的计算。此外，我的代码是乘以1毫秒（在excel中，1小时是1/24/3600/1000=1.15741E-08或0.0000000 115741）。我的代码将这个数字乘以某个整数
i
比如2，这将得到Excel解释的2毫秒的十进制值。然后，我尝试将这个小小数添加到
Now
，以便它等待2毫秒。然后在下一个循环中，它将增加3毫秒，然后是4毫秒，依此类推。我预计需要等待2分钟才能循环500次迭代。很抱歉，您的思维过激，逻辑不正确。一毫秒是一秒的千分之一。它不是.0000000 5741秒。十进制形式下，毫秒是.001。你也在我的答案上打了一个否定的分数，这完全符合你的要求。当你把一个分数乘以一个整数，你是在除法，而不是加法。因此，我不再试图帮助你了。祝你好运。一毫秒代表一天的0.0000000115741。(.001 / 6
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

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