加载VBA用户表单时没有足够的内存崩溃

时间:2018-05-02 17:52:59

标签: excel-vba controls userform vba excel

背景

我有一个VBA用户表单,其中包含约1050个复选框和~100个标签,所有这些都是从活动工作表中填充的。基于ActiveCell.Row直接从工作表中获取标签(t和i是与ActiveCell相关的特定信息的行,其中在同一工作表上有20个不同的表,其中用户表单将从双倍处拉出-clicked)。

加载用户形式的事件(" 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

2 个答案:

答案 0 :(得分: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 :(得分:2)

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

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

并且从不通过他们的代码名称:

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

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

那是大约15年前,直到今天我还不清楚为什么它有效以及为什么在地球上我甚至认为以这种方式利用Controls可能与修复它有关。 As I learned today,Excel中可以通过名称直接解决的控件数量是一个长期存在的限制 - 一个文档记录不足的限制,以及执行不当的限制,因为这样的限制必然会产生编译错误而不是随机时刻的运行时错误。