加载VBA用户表单时没有足够的内存崩溃 [英] Not enough memory crash when loading VBA userform

问题描述

背景：

我有一个VBA用户窗体，其中有〜1050个复选框和〜100个标签，所有这些都从活动工作表中填充。标签是根据ActiveCell直接从工作表中获取的。行（t和i是与ActiveCell相关的特定信息的行，其中同一工作表上有20个不同的表，当用户表单加倍时将从中提取用户信息

I have a VBA userform with ~1050 checkboxes, and ~100 labels, all populated from the active Sheet. The labels are taken directly from the sheet, based on the ActiveCell.Row (t and i are the rows of specific information in relation to the ActiveCell, where there are 20 different tables on the same sheet where the userform would be pulled from when double-clicked).

加载用户表单（ Stb）的事件是双击事件，似乎并未引起问题。

The event to load the userform ("Stb") is a doubleclick event which doesn't appear to cause the issue.

问题：

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

Seemingly random, Excel crashes stating I am using too much memory, that I should use the x64 version if I keep having the issue. I believe it is tied to the loop in my code.

我玩过循环中的行数，这有助于避免崩溃全部发生计算机，但是有些用户的旧计算机比其他计算机更容易崩溃。

I have played with the quantity of lines within the loop and it has helped to not have the crash happen on all computers, but some users have older computers that crash more often than others.

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

All users have 6 GB of RAM in their system (not sure how relevant that is), using Win7 and Office 365 (Office 2016).

问题：

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

Is there anything beyond that loop which appear to cause the memory issue? To my limited knowledge, the storage of variables/captions has to happen in an initialization prior to the userform loading, since the userform cannot update once it has loaded. Is my understanding wrong, where I may be able to refresh the userform while/after it is loaded?

我需要将所有信息保持相似的格式，但是也许我错过了效率……在这方面提供任何帮助将不胜感激（我知道这更适合代码审查，尽管如果系统崩溃，代码将无法工作）。

I need to keep all of the information in a similar format, but maybe I am missing out on efficiencies... anything to help in that direction would be appreciated (I know that is better suited towards Code Review, though the code does not work if the system crashes).

有问题的代码

抱歉，这有点长。

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

推荐答案

我曾经用 many 控件，方法是确保代码始终通过 Controls 集合引用所有控件：

I once fixed a crashing Excel form with many controls by making sure the code always refers all controls via the Controls collection:

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

，并且永远不会通过其代号：

and never via their code names:

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

这很奇怪，但是有效。

尝试替换所有 Stb.Cond1.Caption 与 Stb.Controls（ Cond1）。Caption 等。

It was weird, but it worked.
Try replacing all your Stb.Cond1.Caption with Stb.Controls("Cond1").Caption etc.

那是大约15年前的事了，直到今天，我仍然不清楚为什么它起作用以及为什么在地球上我什至认为利用控件可能与修复它有关。 据我今天了解，在Excel中长期存在的限制是可以直接通过其名称直接处理的控件的数量-记录不充分的限制，以及实现得不好的控件，因为这样的限制必须随机产生编译错误而不是运行时错误时刻。

That was about 15 years ago, and up until today it remained unclear to me why it worked and why on Earth I even thought that utilising Controls in this way might have something to do with fixing it. As I learned today, it is a long standing limitation in Excel on the number of controls that can be addressed directly by their name - a poorly documented limitation, and a poorly implemented one too, as such a limitation must produce a compilation error rather than a runtime error at a random moment.

这篇关于加载VBA用户表单时没有足够的内存崩溃的文章就介绍到这了，希望我们推荐的答案对大家有所帮助，也希望大家多多支持IT屋！