加载 VBA 用户窗体时内存不足崩溃
Not enough memory crash when loading VBA userform
背景:
我有一个 VBA 用户表单,其中包含约 1050 个复选框和约 100 个标签,全部来自活动 Sheet。标签直接取自sheet,基于ActiveCell.Row(t和i是ActiveCell相关的具体信息行,同一个[=53=上有20个不同的表] 双击时用户窗体将被拉出的位置)。
加载用户窗体的事件 ("Stb") 是双击事件,似乎不会导致问题。
问题:
看似随机,Excel 崩溃说明我使用了太多内存,如果问题一直存在,我应该使用 x64 版本。我相信它与我的代码中的循环有关。
我试过循环中的行数,它有助于避免所有计算机上发生崩溃,但有些用户的旧计算机比其他人更容易崩溃。
使用 Win7 和 Office 365 (Office 2016) 的所有用户的系统中都有 6 GB 的 RAM(不确定这有多重要)。
问题:
除了那个循环之外还有什么似乎会导致内存问题吗?据我所知, variables/captions 的存储必须在用户窗体加载之前的初始化中发生,因为用户窗体一旦加载就无法更新。我的理解有误吗,我可以在哪里刷新已加载的用户表单while/after?
我需要以类似的格式保存所有信息,但也许我错过了效率......任何有助于这方面的帮助将不胜感激(我知道这更适合代码审查,虽然如果系统崩溃,代码将不起作用。
问题代码:
抱歉,这有点长。
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
我不能说为什么你的 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
我曾经通过确保代码始终通过 Controls
集合引用所有控件来修复带有 许多 控件的崩溃 Excel 表单:
Me.Controls("Cond1").Caption = .Cells(r, c + 1)
永远不会通过他们的代号:
Me.Cond1.Caption = .Cells(r, c + 1)
这很奇怪,但它奏效了。
尝试将所有 Stb.Cond1.Caption
替换为 Stb.Controls("Cond1").Caption
等
那是大约 15 年前的事了,直到今天我仍然不清楚它为什么有效,为什么我什至认为以这种方式利用 Controls
可能与修复它有关。 ,这是 Excel 中对可以直接通过名称直接寻址的控件数量的长期限制 - 一个记录不完整的限制,也是一个实施不当的限制,因为这样的限制必须产生编译错误而不是随机时刻的运行时错误。
背景:
我有一个 VBA 用户表单,其中包含约 1050 个复选框和约 100 个标签,全部来自活动 Sheet。标签直接取自sheet,基于ActiveCell.Row(t和i是ActiveCell相关的具体信息行,同一个[=53=上有20个不同的表] 双击时用户窗体将被拉出的位置)。
加载用户窗体的事件 ("Stb") 是双击事件,似乎不会导致问题。
问题:
看似随机,Excel 崩溃说明我使用了太多内存,如果问题一直存在,我应该使用 x64 版本。我相信它与我的代码中的循环有关。
我试过循环中的行数,它有助于避免所有计算机上发生崩溃,但有些用户的旧计算机比其他人更容易崩溃。
使用 Win7 和 Office 365 (Office 2016) 的所有用户的系统中都有 6 GB 的 RAM(不确定这有多重要)。
问题:
除了那个循环之外还有什么似乎会导致内存问题吗?据我所知, variables/captions 的存储必须在用户窗体加载之前的初始化中发生,因为用户窗体一旦加载就无法更新。我的理解有误吗,我可以在哪里刷新已加载的用户表单while/after?
我需要以类似的格式保存所有信息,但也许我错过了效率......任何有助于这方面的帮助将不胜感激(我知道这更适合代码审查,虽然如果系统崩溃,代码将不起作用。
问题代码:
抱歉,这有点长。
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
我不能说为什么你的 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
我曾经通过确保代码始终通过 Controls
集合引用所有控件来修复带有 许多 控件的崩溃 Excel 表单:
Me.Controls("Cond1").Caption = .Cells(r, c + 1)
永远不会通过他们的代号:
Me.Cond1.Caption = .Cells(r, c + 1)
这很奇怪,但它奏效了。
尝试将所有 Stb.Cond1.Caption
替换为 Stb.Controls("Cond1").Caption
等
那是大约 15 年前的事了,直到今天我仍然不清楚它为什么有效,为什么我什至认为以这种方式利用 Controls
可能与修复它有关。