我在 VBA 宏中得到 Procedure too Large Error。
我正在使用 MS-Excel 2003。
【问题讨论】：
标签： vba excel excel-2003
如果您的程序超过 64kb，您将收到该错误。这些是您可以压缩代码的一些东西
1) 摆脱重复代码。看这个例子
Sub Sample()
Range("A1") = "Blah Blah"
Range("A2") = "Blah Blah"
Range("A3") = "Blah Blah"
Range("A4") = "Blah Blah"
Range("A5") = "Blah Blah"
Range("A6") = "Blah Blah"
Range("A7") = "Blah Blah"
End Sub
这段代码可以写成
Sub Sample()
For i = 1 To 7
Range("A" & i) = "Blah Blah"
Next i
End Sub
另一个例子
Sub Sample()
Range("A1") = (Range("A1") * 10) + (Range("A1") + 30) + (Range("A1") / 30)
Range("A5") = (Range("A5") * 10) + (Range("A5") + 30) + (Range("A5") / 30)
Range("A11") = (Range("A11") * 10) + (Range("A11") + 30) + (Range("A11") / 30)
Range("A6") = (Range("A6") * 10) + (Range("A6") + 30) + (Range("A6") / 30)
Range("A8") = (Range("A8") * 10) + (Range("A8") + 30) + (Range("A8") / 30)
Range("A56") = (Range("A56") * 10) + (Range("A56") + 30) + (Range("A56") / 30)
End Sub
这段代码可以写成
Sub Sample()
Range("A1") = GetVal(Range("A1"))
Range("A5") = GetVal(Range("A5"))
Range("A11") = GetVal(Range("A11"))
Range("A6") = GetVal(Range("A6"))
Range("A8") = GetVal(Range("A8"))
Range("A56") = GetVal(Range("A56"))
End Sub
Function GetVal(rng As Range) As Variant
GetVal = (rng.Value * 10) + (rng.Value + 30) + (rng.Value / 30)
End Function
这将确保您减少空间并且不会编写重复的代码。
2) 如果您通过宏生成代码，那么您可能会得到类似的结果。去掉ActiveWindow.ScrollRow = 8968之类的无用代码
Option Explicit
'~~> This procedure fills Excel's 10000 cells with random values and then removes the duplicates
Sub FillExcelCells()
Dim rowCount As Long
'~~> Activate the necesary Sheet
Sheets("Sheet1").Activate
'~~> Loop through all the cells and store random numbers
For rowCount = 1 To 10000
Sheets("Sheet1").Range("A" & rowCount).Select
Sheets("Sheet1").Range("A" & rowCount).Value = Int((10000 - 1) * Rnd() + 1)
Next rowCount
'~~> Sort the Range
Sheets("Sheet1").Range("A1").Select
Sheets("Sheet1").Range(Selection, Selection.End(xlDown)).Select
Application.CutCopyMode = False
Range(Selection, Selection.End(xlDown)).Select
ActiveWindow.SmallScroll Down:=-39
ActiveWindow.ScrollRow = 9838
ActiveWindow.ScrollRow = 9709
ActiveWindow.ScrollRow = 9449
ActiveWindow.ScrollRow = 8968
ActiveWindow.ScrollRow = 8319
ActiveWindow.ScrollRow = 7245
ActiveWindow.ScrollRow = 6003
ActiveWindow.ScrollRow = 4818
ActiveWindow.ScrollRow = 4040
ActiveWindow.ScrollRow = 3317
ActiveWindow.ScrollRow = 3076
ActiveWindow.ScrollRow = 2521
ActiveWindow.ScrollRow = 2298
ActiveWindow.ScrollRow = 2113
ActiveWindow.ScrollRow = 1724
ActiveWindow.ScrollRow = 1372
ActiveWindow.ScrollRow = 1038
ActiveWindow.ScrollRow = 872
ActiveWindow.ScrollRow = 668
ActiveWindow.ScrollRow = 538
ActiveWindow.ScrollRow = 464
ActiveWindow.ScrollRow = 446
ActiveWindow.ScrollRow = 427
ActiveWindow.ScrollRow = 409
ActiveWindow.ScrollRow = 390
ActiveWindow.ScrollRow = 353
ActiveWindow.ScrollRow = 334
ActiveWindow.ScrollRow = 297
ActiveWindow.ScrollRow = 279
ActiveWindow.ScrollRow = 242
ActiveWindow.ScrollRow = 223
ActiveWindow.ScrollRow = 205
ActiveWindow.ScrollRow = 168
ActiveWindow.ScrollRow = 149
ActiveWindow.ScrollRow = 112
ActiveWindow.ScrollRow = 94
ActiveWindow.ScrollRow = 57
ActiveWindow.ScrollRow = 20
ActiveWindow.ScrollRow = 1
Selection.Sort Key1:=Sheets("Sheet1").Range("A1"), Order1:=xlAscending, Header:=xlGuess, _
OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom, _
DataOption1:=xlSortNormal
'~~> Delete duplicates
For rowCount = 10000 To 2 Step -1
Sheets("Sheet1").Range("A" & rowCount).Select
If Range("A" & rowCount).Value = Range("A" & rowCount - 1).Value Then
Sheets("Sheet1").Rows(rowCount).Delete shift:=xlUp
End If
Next rowCount
End Sub
上面可以写成
'~~> This procedure fills Excel's 10000 cells with random values and then removes the duplicates
Sub FillExcelCells()
Dim rowCount As Long
With Sheets("Sheet1")
'~~> Loop through all the cells and store random numbers
For rowCount = 1 To 10000
.Range("A" & rowCount).Value = Int((10000 - 1) * Rnd() + 1)
Next rowCount
'~~> Sort Range
.Range("A1:A10000").Sort Key1:=.Range("A1"), Order1:=xlAscending, Header:=xlGuess, _
OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom, DataOption1:=xlSortNormal
'~~> Delete duplicates
For rowCount = 10000 To 2 Step -1
If .Range("A" & rowCount).Value = .Range("A" & rowCount - 1).Value Then
.Rows(rowCount).Delete shift:=xlUp
End If
Next rowCount
End With
End Sub
3) 声明你的对象，这样你就不必一直重复它们。看这个例子
Sub Sample()
Range("A1").Select
ActiveCell.FormulaR1C1 = "sdasds"
Range("A1").Select
With Selection.Interior
.Pattern = xlSolid
.PatternColorIndex = xlAutomatic
.Color = 65535
.TintAndShade = 0
.PatternTintAndShade = 0
End With
Selection.Font.Bold = True
Selection.Font.Italic = True
Selection.Font.Underline = xlUnderlineStyleSingle
With Selection
.HorizontalAlignment = xlGeneral
.VerticalAlignment = xlBottom
.WrapText = True
.Orientation = 0
.AddIndent = False
.IndentLevel = 0
.ShrinkToFit = False
.ReadingOrder = xlContext
.MergeCells = False
End With
End Sub
这可以写成
Sub Sample()
Dim ws As Worksheet, rng As Range
Set ws = Sheet1
Set rng = ws.Range("A1")
With rng
.FormulaR1C1 = "sdasds"
With .Interior
.Pattern = xlSolid
.PatternColorIndex = xlAutomatic
.Color = 65535
.TintAndShade = 0
.PatternTintAndShade = 0
End With
.Font.Bold = True
.Font.Italic = True
.Font.Underline = xlUnderlineStyleSingle
.HorizontalAlignment = xlGeneral
.VerticalAlignment = xlBottom
.WrapText = True
.Orientation = 0
.AddIndent = False
.IndentLevel = 0
.ShrinkToFit = False
.ReadingOrder = xlContext
.MergeCells = False
End With
End Sub
4) 如果需要，分解您的程序。并从第一个程序调用第二个程序
5) 避免使用.Select 和.Activate 它们不仅会使您的代码变慢，而且如果广泛使用它们还会占用代码中的大量空间。 How to avoid using Select in Excel VBA macros
【讨论】：
Round(ThisWorkbook.Worksheets("Sheet5").Range("NamedRange").Value, 5)。我将它们全部替换为单个 integer 变量，因此 Round(...) 仅被调用一次。这也使该方法更易于维护。它现在可能也运行得更快了。
宏大小限制为 64kb，之后您将收到来自 Excel 的错误消息。
我遇到了一个问题，没有来自 Excel 的解释或错误消息，当我编写一个调用多个其他宏的宏时，Excel 无法完全计算工作簿的资源不足。
我假设需要考虑链中所有宏的长度总和。
【讨论】：