加载 VBA 用户窗体时没有足够的内存崩溃

Posted 2023-02-22

技术标签:

【中文标题】加载 VBA 用户窗体时没有足够的内存崩溃【英文标题】：Not enough memory crash when loading VBA userform 【发布时间】：2018-10-12 22:10:48 【问题描述】：

背景：

我有一个带有 ~1050 个复选框和 ~100 个标签的 VBA 用户表单，所有这些都从活动工作表中填充。标签直接取自工作表，基于 ActiveCell.Row （t 和 i 是与 ActiveCell 相关的特定信息的行，其中在同一张工作表上有 20 个不同的表，当加倍时，用户窗体将从这些表中提取-点击）。

加载用户表单的事件（“Stb”）是一个双击事件，似乎不会导致问题。

问题：

看似随机的 Excel 崩溃表明我使用了太多内存，如果我一直遇到问题，我应该使用 x64 版本。我相信它与我的代码中的循环有关。

我玩过循环中的行数，这有助于避免所有计算机都发生崩溃，但有些用户的旧计算机比其他用户更频繁地崩溃。

使用 Win7 和 Office 365 (Office 2016)，所有用户的系统中都有 6 GB RAM（不确定这有多相关）。

问题：

除了那个循环之外还有什么东西会导致内存问题吗？据我所知，变量/标题的存储必须在加载用户表单之前的初始化中进行，因为用户表单一旦加载就无法更新。我的理解是否错误，我可以在加载时/之后刷新用户表单？

我需要以类似的格式保存所有信息，但也许我错过了效率...任何有助于朝这个方向提供帮助的东西将不胜感激（我知道这更适合代码审查，尽管代码如果系统崩溃则不起作用）。

有问题的代码：

抱歉，有点长。

Private Sub UserForm_Initialize()
    Dim r As Long, c As Long, i As Long, t As Long, v As Long
    r = ActiveCell.Row
    c = 3
    Select Case r
        Case 25 To 44 '1
            i = 52
            t = 24
        Case 115 To 134 '2
            i = 142
            t = 114
        Case 205 To 224 '3
            i = 232
            t = 204
        Case 295 To 314 '4
            i = 322
            t = 294
        Case 385 To 404 '5
            i = 412
            t = 384
        Case 475 To 494 '6
            i = 502
            t = 474
        Case 565 To 584 '7
            i = 592
            t = 564
        Case 655 To 674 '8
            i = 682
            t = 654
        Case 745 To 764 '9
            i = 772
            t = 744
        Case 835 To 854 '10
            i = 862
            t = 834
        Case 925 To 944 '11
            i = 952
            t = 924
        Case 1015 To 1034 '12
            i = 1042
            t = 1014
        Case 1105 To 1124 '13
            i = 1132
            t = 1104
        Case 1195 To 1214 '14
            i = 1222
            t = 1194
        Case 1285 To 1304 '15
            i = 1312
            t = 1284
        Case 1375 To 1394 '16
            i = 1402
            t = 1374
        Case 1465 To 1484 '17
            i = 1492
            t = 1464
        Case 1555 To 1574 '18
            i = 1582
            t = 1554
        Case 1645 To 1664 '19
            i = 1672
            t = 1644
        Case 1735 To 1754 '20
            i = 1762
            t = 1734
    End Select
    With Sheets("Stability")
        Stb.Cond1.Caption = .Cells(r, c + 1)
        Stb.Cond2.Caption = .Cells(r, c + 1)
        Stb.TP01.Caption = .Cells(t, c + 3)
        Stb.TP02.Caption = .Cells(t, c + 4)
        Stb.TP03.Caption = .Cells(t, c + 5)
        Stb.TP04.Caption = .Cells(t, c + 6)
        Stb.TP05.Caption = .Cells(t, c + 7)
        Stb.TP06.Caption = .Cells(t, c + 8)
        Stb.TP07.Caption = .Cells(t, c + 9)
        Stb.TP08.Caption = .Cells(t, c + 10)
        Stb.TP09.Caption = .Cells(t, c + 11)
        Stb.TP10.Caption = .Cells(t, c + 12)
        Stb.TP11.Caption = .Cells(t, c + 13)
        Stb.TP12.Caption = .Cells(t, c + 14)
        Stb.TP13.Caption = .Cells(t, c + 15)
        Stb.TP14.Caption = .Cells(t, c + 16)
        Stb.TP15.Caption = .Cells(t, c + 17)
        Stb.TP16.Caption = .Cells(t, c + 18)
        Stb.TP17.Caption = .Cells(t, c + 19)
        Stb.TP18.Caption = .Cells(t, c + 20)
        Stb.TP19.Caption = .Cells(t, c + 21)
        Stb.TP20.Caption = .Cells(t, c + 22)
        Stb.TP21.Caption = .Cells(t, c + 23)
        Stb.TP22.Caption = .Cells(t, c + 24)
        Stb.TP23.Caption = .Cells(t, c + 25)
        Stb.TP24.Caption = .Cells(t, c + 26)
        Stb.TP25.Caption = .Cells(t, c + 27)
        Stb.TP26.Caption = .Cells(t, c + 28)
        Stb.TP27.Caption = .Cells(t, c + 29)
        Stb.TP28.Caption = .Cells(t, c + 30)
        Stb.TP29.Caption = .Cells(t, c + 31)
        Stb.TP01x.Caption = .Cells(t, c + 3)
        Stb.TP02x.Caption = .Cells(t, c + 4)
        Stb.TP03x.Caption = .Cells(t, c + 5)
        Stb.TP04x.Caption = .Cells(t, c + 6)
        Stb.TP05x.Caption = .Cells(t, c + 7)
        Stb.TP06x.Caption = .Cells(t, c + 8)
        Stb.TP07x.Caption = .Cells(t, c + 9)
        Stb.TP08x.Caption = .Cells(t, c + 10)
        Stb.TP09x.Caption = .Cells(t, c + 11)
        Stb.TP10x.Caption = .Cells(t, c + 12)
        Stb.TP11x.Caption = .Cells(t, c + 13)
        Stb.TP12x.Caption = .Cells(t, c + 14)
        Stb.TP13x.Caption = .Cells(t, c + 15)
        Stb.TP14x.Caption = .Cells(t, c + 16)
        Stb.TP15x.Caption = .Cells(t, c + 17)
        Stb.TP16x.Caption = .Cells(t, c + 18)
        Stb.TP17x.Caption = .Cells(t, c + 19)
        Stb.TP18x.Caption = .Cells(t, c + 20)
        Stb.TP19x.Caption = .Cells(t, c + 21)
        Stb.TP20x.Caption = .Cells(t, c + 22)
        Stb.TP21x.Caption = .Cells(t, c + 23)
        Stb.TP22x.Caption = .Cells(t, c + 24)
        Stb.TP23x.Caption = .Cells(t, c + 25)
        Stb.TP24x.Caption = .Cells(t, c + 26)
        Stb.TP25x.Caption = .Cells(t, c + 27)
        Stb.TP26x.Caption = .Cells(t, c + 28)
        Stb.TP27x.Caption = .Cells(t, c + 29)
        Stb.TP28x.Caption = .Cells(t, c + 30)
        Stb.TP29x.Caption = .Cells(t, c + 31)
        Stb.tA.Caption = .Cells(i, c + 1)
        Stb.tB.Caption = .Cells(i + 1, c + 1)
        Stb.tC.Caption = .Cells(i + 2, c + 1)
        Stb.tD.Caption = .Cells(i + 3, c + 1)
        Stb.tE.Caption = .Cells(i + 4, c + 1)
        Stb.tF.Caption = .Cells(i + 5, c + 1)
        Stb.tG.Caption = .Cells(i + 6, c + 1)
        Stb.tH.Caption = .Cells(i + 7, c + 1)
        Stb.tI.Caption = .Cells(i + 8, c + 1)
        Stb.tJ.Caption = .Cells(i + 9, c + 1)
        Stb.tK.Caption = .Cells(i + 10, c + 1)
        Stb.tL.Caption = .Cells(i + 11, c + 1)
        Stb.tM.Caption = .Cells(i + 12, c + 1)
        Stb.tN.Caption = .Cells(i + 13, c + 1)
        Stb.teO.Caption = .Cells(i + 14, c + 1)
        Stb.tP.Caption = .Cells(i + 15, c + 1)
        Stb.tQ.Caption = .Cells(i + 16, c + 1)
        Stb.tR.Caption = .Cells(i + 17, c + 1)
        Stb.tS.Caption = .Cells(i + 18, c + 1)
        Stb.tT.Caption = .Cells(i + 19, c + 1)
        Stb.tU.Caption = .Cells(i + 20, c + 1)
        Stb.tV.Caption = .Cells(i + 21, c + 1)
        Stb.tW.Caption = .Cells(i + 22, c + 1)
        Stb.tX.Caption = .Cells(i + 23, c + 1)
        Stb.tY.Caption = .Cells(i + 24, c + 1)
        Stb.tZ.Caption = .Cells(i + 25, c + 1)
        'skip row 78
        Stb.oA.Caption = .Cells(i + 27, c + 1)
        Stb.oB.Caption = .Cells(i + 28, c + 1)
        Stb.oC.Caption = .Cells(i + 29, c + 1)
        Stb.oD.Caption = .Cells(i + 30, c + 1)
        Stb.oE.Caption = .Cells(i + 31, c + 1)
        Stb.oF.Caption = .Cells(i + 32, c + 1)
        Stb.oG.Caption = .Cells(i + 33, c + 1)
        Stb.oH.Caption = .Cells(i + 34, c + 1)
        Stb.oI.Caption = .Cells(i + 35, c + 1)
        For v = 0 To 28
            If Len(WorksheetFunction.Substitute(.Cells(r, c + 3 + v), "a", "")) < Len(.Cells(r, c + 3 + v)) Then Controls("CheckBox" & 1 + v).Value = True
            If Len(WorksheetFunction.Substitute(.Cells(r, c + 3 + v), "b", "")) < Len(.Cells(r, c + 3 + v)) Then Controls("CheckBox" & 31 + v).Value = True
            If Len(WorksheetFunction.Substitute(.Cells(r, c + 3 + v), "c", "")) < Len(.Cells(r, c + 3 + v)) Then Controls("CheckBox" & 61 + v).Value = True
            If Len(WorksheetFunction.Substitute(.Cells(r, c + 3 + v), "d", "")) < Len(.Cells(r, c + 3 + v)) Then Controls("CheckBox" & 91 + v).Value = True
            If Len(WorksheetFunction.Substitute(.Cells(r, c + 3 + v), "e", "")) < Len(.Cells(r, c + 3 + v)) Then Controls("CheckBox" & 121 + v).Value = True
            If Len(WorksheetFunction.Substitute(.Cells(r, c + 3 + v), "f", "")) < Len(.Cells(r, c + 3 + v)) Then Controls("CheckBox" & 151 + v).Value = True
        Next v
        For v = 0 To 28
            If Len(WorksheetFunction.Substitute(.Cells(r, c + 3 + v), "g", "")) < Len(.Cells(r, c + 3 + v)) Then Controls("CheckBox" & 181 + v).Value = True
            If Len(WorksheetFunction.Substitute(.Cells(r, c + 3 + v), "h", "")) < Len(.Cells(r, c + 3 + v)) Then Controls("CheckBox" & 211 + v).Value = True
            If Len(WorksheetFunction.Substitute(.Cells(r, c + 3 + v), "i", "")) < Len(.Cells(r, c + 3 + v)) Then Controls("CheckBox" & 241 + v).Value = True
            If Len(WorksheetFunction.Substitute(.Cells(r, c + 3 + v), "j", "")) < Len(.Cells(r, c + 3 + v)) Then Controls("CheckBox" & 271 + v).Value = True
            If Len(WorksheetFunction.Substitute(.Cells(r, c + 3 + v), "k", "")) < Len(.Cells(r, c + 3 + v)) Then Controls("CheckBox" & 301 + v).Value = True
            If Len(WorksheetFunction.Substitute(.Cells(r, c + 3 + v), "l", "")) < Len(.Cells(r, c + 3 + v)) Then Controls("CheckBox" & 331 + v).Value = True
        Next v
        For v = 0 To 28
            If Len(WorksheetFunction.Substitute(.Cells(r, c + 3 + v), "m", "")) < Len(.Cells(r, c + 3 + v)) Then Controls("CheckBox" & 361 + v).Value = True
            If Len(WorksheetFunction.Substitute(.Cells(r, c + 3 + v), "n", "")) < Len(.Cells(r, c + 3 + v)) Then Controls("CheckBox" & 391 + v).Value = True
            If Len(WorksheetFunction.Substitute(.Cells(r, c + 3 + v), "o", "")) < Len(.Cells(r, c + 3 + v)) Then Controls("CheckBox" & 421 + v).Value = True
            If Len(WorksheetFunction.Substitute(.Cells(r, c + 3 + v), "p", "")) < Len(.Cells(r, c + 3 + v)) Then Controls("CheckBox" & 451 + v).Value = True
            If Len(WorksheetFunction.Substitute(.Cells(r, c + 3 + v), "q", "")) < Len(.Cells(r, c + 3 + v)) Then Controls("CheckBox" & 481 + v).Value = True
            If Len(WorksheetFunction.Substitute(.Cells(r, c + 3 + v), "r", "")) < Len(.Cells(r, c + 3 + v)) Then Controls("CheckBox" & 511 + v).Value = True
        Next v
        For v = 0 To 28
            If Len(WorksheetFunction.Substitute(.Cells(r, c + 3 + v), "s", "")) < Len(.Cells(r, c + 3 + v)) Then Controls("CheckBox" & 541 + v).Value = True
            If Len(WorksheetFunction.Substitute(.Cells(r, c + 3 + v), "t", "")) < Len(.Cells(r, c + 3 + v)) Then Controls("CheckBox" & 571 + v).Value = True
            If Len(WorksheetFunction.Substitute(.Cells(r, c + 3 + v), "u", "")) < Len(.Cells(r, c + 3 + v)) Then Controls("CheckBox" & 601 + v).Value = True
            If Len(WorksheetFunction.Substitute(.Cells(r, c + 3 + v), "v", "")) < Len(.Cells(r, c + 3 + v)) Then Controls("CheckBox" & 631 + v).Value = True
            If Len(WorksheetFunction.Substitute(.Cells(r, c + 3 + v), "w", "")) < Len(.Cells(r, c + 3 + v)) Then Controls("CheckBox" & 661 + v).Value = True
            If Len(WorksheetFunction.Substitute(.Cells(r, c + 3 + v), "x", "")) < Len(.Cells(r, c + 3 + v)) Then Controls("CheckBox" & 691 + v).Value = True
        Next v
        For v = 0 To 28
            If Len(WorksheetFunction.Substitute(.Cells(r, c + 3 + v), "y", "")) < Len(.Cells(r, c + 3 + v)) Then Controls("CheckBox" & 721 + v).Value = True
            If Len(WorksheetFunction.Substitute(.Cells(r, c + 3 + v), "z", "")) < Len(.Cells(r, c + 3 + v)) Then Controls("CheckBox" & 751 + v).Value = True
            If Len(WorksheetFunction.Substitute(.Cells(r, c + 3 + v), "1", "")) < Len(.Cells(r, c + 3 + v)) Then Controls("CheckBox" & 781 + v).Value = True
            If Len(WorksheetFunction.Substitute(.Cells(r, c + 3 + v), "2", "")) < Len(.Cells(r, c + 3 + v)) Then Controls("CheckBox" & 811 + v).Value = True
            If Len(WorksheetFunction.Substitute(.Cells(r, c + 3 + v), "3", "")) < Len(.Cells(r, c + 3 + v)) Then Controls("CheckBox" & 841 + v).Value = True
            If Len(WorksheetFunction.Substitute(.Cells(r, c + 3 + v), "4", "")) < Len(.Cells(r, c + 3 + v)) Then Controls("CheckBox" & 871 + v).Value = True
        Next v
        For v = 0 To 28
            If Len(WorksheetFunction.Substitute(.Cells(r, c + 3 + v), "5", "")) < Len(.Cells(r, c + 3 + v)) Then Controls("CheckBox" & 901 + v).Value = True
            If Len(WorksheetFunction.Substitute(.Cells(r, c + 3 + v), "6", "")) < Len(.Cells(r, c + 3 + v)) Then Controls("CheckBox" & 931 + v).Value = True
            If Len(WorksheetFunction.Substitute(.Cells(r, c + 3 + v), "7", "")) < Len(.Cells(r, c + 3 + v)) Then Controls("CheckBox" & 961 + v).Value = True
            If Len(WorksheetFunction.Substitute(.Cells(r, c + 3 + v), "8", "")) < Len(.Cells(r, c + 3 + v)) Then Controls("CheckBox" & 991 + v).Value = True
            If Len(WorksheetFunction.Substitute(.Cells(r, c + 3 + v), "9", "")) < Len(.Cells(r, c + 3 + v)) Then Controls("CheckBox" & 1021 + v).Value = True
        Next v
    End With 
End Sub

【问题讨论】：

我曾经通过确保我通过Controls 集合而不是通过它们的代码名称引用这些控件来修复一个带有许多控件的崩溃Excel 表单。这很奇怪，但它奏效了。尝试用Me.Controls("Stb").etc 替换所有Stb.Cond1.Caption。 @GSerg 我认为这就是我所有崩溃的原因。我还有一个用户要测试（我的每次崩溃），如果它有效，那么该提示将解决问题......现在，如果我们只知道为什么会发生这种变化的确切理由。 a) 我记得以前的 Excel 2000/2003 限制最多 411 个 UF 控件，可以通过名称直接寻址，b) 而超出的控件必须作为 控件的成员来寻址集合（例如For each myControl in Me.Controls 或通过项目索引）。 c) 手动删除 TabIndex 属性编号小于 411 的控件（例如代码中未使用的标签）包括上述限制范围内的下一个控件。请注意，更改此道具不会改变行为；行为似乎完全由创建控件的顺序决定。基本原理：VBA 限制了 UF 控件的直接引用，例如Label1.Caption = "..."。 - 所以你可以总结所有可能的解决方案如下： [1.] 通过Controls 集合（循环、索引或名称）使用间接引用 [2.] 减少控件的数量，例如通过将控件分发到多个用户表单 [3.] 重新组织控件的顺序，例如通过删除静态标签并再次添加它们（上面评论中的点 c）。 - 注意：我知道的唯一支持链接 (support.microsoft.com/en-us/kb/177842) 不再存在。 @GSerg 这就是解决这个问题的方法，TM 给出了理由。如果您想发布作为答案，我可以接受。谢谢！ 【参考方案1】：

我曾经通过确保代码始终通过 Controls 集合引用所有控件来修复带有许多控件的崩溃 Excel 表单：

Me.Controls("Cond1").Caption = .Cells(r, c + 1)

而且从不通过他们的代号：

Me.Cond1.Caption = .Cells(r, c + 1)

这很奇怪，但确实有效。尝试用Stb.Controls("Cond1").Caption 等替换所有Stb.Cond1.Caption。

那是大约 15 年前的事了，直到今天我仍然不清楚它为什么会起作用，为什么在地球上我什至认为以这种方式使用 Controls 可能与修复它有关。 As I learned today，Excel 中长期存在的限制是可以通过名称直接解决的控件数量 - 一个记录不充分的限制，也是一个执行不力的限制，因为这样的限制必须产生编译错误而不是随机出现的运行时错误。

【讨论】：

再次，高度赞赏。在你和 TM 在 cmets 中的解释之间，我绝对是在更好地理解。我同意所描述的行为记录不充分。我很高兴提供了一个理由（即使是 15 年后）并展示了一些可能的解决方案。 +)【参考方案2】：

我无法解释您的 Excel 崩溃的原因，但您可以通过将一些值加载到 Array 中来减少一些代码，然后您可以有两个嵌套循环，而不是 6 个 For v = 0 to 28 循环一个遍历你的数组：

Dim start As Long, z As Long, arr As Variant

start = 1
arr = Array("a", "b", "c", "d", "e", "f", "g", "h", "i", "j", "k", "l", "m", "n", "o", "p", "q", "r", "s", "t", "u", "v", "w", "x", "y", "z", "1", "2", "3", "4", "5", "6", "7", "8", "9")

For v = 0 To 28
    For z = 0 To UBound(arr)
        If Len(WorksheetFunction.Substitute(.Cells(r, c + 3 + v), arr(z), "")) < Len(.Cells(r, c + 3 + v)) Then Controls("CheckBox" & start + v).Value = True
        start = start + 30
    Next z
    start = 1
Next

【讨论】：

我可能可以对其他一些标签件做同样的事情。将尝试一下，然后在几个人的计算机上进行测试，看看我是否没有遇到其他问题。谢谢！到目前为止在测试中，这还没有引起问题！在使用我收到的第一个提示进行测试后添加了这个，我认为这解决了我的主要内存问题。会给你+1，但如果其他人将他的帖子作为答案，我会接受他的。非常感谢您，它就像一个魅力！ @Cyril 不用担心！我不认为这可以解决这个问题 - 只是想把这个改变扔在那里。

以上是关于加载 VBA 用户窗体时没有足够的内存崩溃的主要内容，如果未能解决你的问题，请参考以下文章

Excel 崩溃，VBA 用户窗体无法保存

从用户窗体 vba 加载的公共数组

单击父窗体时不会触发访问 VBA 子窗体事件

为啥从标准模块（而不是用户窗体）调用 VBA 代码时运行得更快？

使用 VBA 从主窗体设置子窗体上的窗体属性

ListBox（用户窗体）VBA中的多列