跑出VBA内存 [英] Running out of VBA Memory

问题描述

我运行下面的代码，这正是我想要的。
我正在使用的问题是，当我保持该工作表运行一段时间，如10分钟，我得到一个弹出错误消息，说我已经用完了内存。

有没有什么可以放在我的代码中，我可以用来防止这种情况？

我的代码如下，

  Sub auto_open（）
调用ScheduleCopyPriceOver 
 End Sub 
 
 
 Sub ScheduleCopyPriceOver （）
 TimeToRun = Now + TimeValue（00:00:10）
 Application.OnTime TimeToRun，CopyPriceOver
 End Sub 
 
 Sub CopyPriceOver（） 
 Dim lRow As Long 
 Dim ws As Worksheet 
 
设置ws = ThisWorkbook.Sheets（Orders）
 
 
 Application.ScreenUpdating = False 
 
 
 
对于SRow = 1至5000 
如果ws.Cells（SRow，19）= SRow然后
 ws.Cells（SRow， 12）。选择
 ActiveCell.FormulaR1C1 =ready
调用ScheduleCopyPriceOver 
 
 ElseIf ws.Cells（SR ow，20）= SRow然后
 ws.Cells（SRow，12）。选择
 ActiveCell.FormulaR1C1 =取消
 
 
结束如果
 Next 
 
调用ScheduleCopyPriceOver 
 
 
 
 End Sub 
 
 Sub auto_close（）
 On Error Resume Next 
 Application.OnTime TimeToRun，CopyPriceOver，，False 
 End Sub 
  

解决方案

您的溢出几乎肯定是由于这么多计划的事件引起的。

在你的循环中，你安排一个 OnTime 如果任何行的列号作为列S中的值。然后，您还将再安排一次 OnTime ，即使没有行具有列S中的行号。

因此，如果您的5000行中有200行具有匹配值，则将在10秒内为宏设置201个计划的呼叫。当这些201事件发生时，他们可能（取决于10秒内发生的事情）会产生另外40000个事件。 （即使只有一个行，列S的值与行号相匹配，十分钟后，最终将有超过1,000,000,000,000,000个事件排队。）

不需要重新安排 CopyPriceOver 代码多次，因此从内部删除 Call ScheduleCopyPriceOver 循环。

 对于SRow = 1至5000 
如果ws.Cells（SRow，19）.Value = SRow然后
 
 ws.Cells（SRow，12）.FormulaR1C1 =ready
'摆脱下一行
'调用ScheduleCopyPriceOver 
 
 ElseIf ws.Cells（SRow，20）.Value = SRow然后
 
 ws.Cells（SRow，12）.FormulaR1C1 =cancel
 
 End If 
下一步
 
调用ScheduleCopyPriceOver 
  

Im running the code below, which does exactly what I want it to. The issue I am having with it though is that when I keep the sheet running for a period of time like 10 min I get a pop up error message saying I have run out of memory.

Is there something I could put in my code that I could use to prevent this?

My code is as below,

Sub auto_open()
    Call ScheduleCopyPriceOver
End Sub


Sub ScheduleCopyPriceOver()
    TimeToRun = Now + TimeValue("00:00:10")
    Application.OnTime TimeToRun, "CopyPriceOver"
End Sub

Sub CopyPriceOver()
Dim lRow    As Long
Dim ws      As Worksheet

Set ws = ThisWorkbook.Sheets("Orders")


Application.ScreenUpdating = False



    For SRow = 1 To 5000
    If ws.Cells(SRow, 19) = SRow Then
        ws.Cells(SRow, 12).Select
        ActiveCell.FormulaR1C1 = "ready"
        Call ScheduleCopyPriceOver

     ElseIf ws.Cells(SRow, 20) = SRow Then
        ws.Cells(SRow, 12).Select
        ActiveCell.FormulaR1C1 = "cancel"


    End If
    Next

    Call ScheduleCopyPriceOver



End Sub

Sub auto_close()
    On Error Resume Next
    Application.OnTime TimeToRun, "CopyPriceOver", , False
End Sub

解决方案

Your overflow is almost certainly being caused by so many scheduled events.

In your loop, you are scheduling an OnTime if any row has the row number as a value in column S. You are then also scheduling one more OnTime even if no rows have the row number in column S.

So, if 200 of your 5000 rows have a matching value, you will be setting 201 scheduled calls to the macro in 10 seconds time. When those 201 events fire, they might (depending on what has happened within that 10 seconds) generate another 40000+ events. (Even if there was only one row with column S's value matching the row number, after 10 minutes you would end up with over 1,000,000,000,000,000,000 events being queued.)

There is no need to reschedule the CopyPriceOver code more than once, so remove the Call ScheduleCopyPriceOver from within the loop.

For SRow = 1 To 5000
    If ws.Cells(SRow, 19).Value = SRow Then

        ws.Cells(SRow, 12).FormulaR1C1 = "ready"
        'Get rid of the next line
        'Call ScheduleCopyPriceOver

    ElseIf ws.Cells(SRow, 20).Value = SRow Then

        ws.Cells(SRow, 12).FormulaR1C1 = "cancel"

    End If
Next

Call ScheduleCopyPriceOver

这篇关于跑出VBA内存的文章就介绍到这了，希望我们推荐的答案对大家有所帮助，也希望大家多多支持IT屋！