Getting error Procedure too large in VBA Macros (Excel)

问题:

I am getting Procedure too Large Error in a VBA macro.

I am using MS-Excel 2003.

回答1:

You will get that error if your procedure is more than 64kb. These are some of the things that you can to compact your code

1) Get rid of repetitive code. See this example

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 

This code can be written as

Sub Sample()     For i = 1 To 7         Range("A" & i) = "Blah Blah"     Next i End Sub 

Another example

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 

This code can be written as

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 

This will ensure that you cut down on space and do not write repetitive code.

2) If you generated the code via the macro then you may get something like this. Get rid of the useless code like 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 

The above can be written as

'~~> 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) Declare you Objects so that you don't have to keep on repeating them. See this example

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 

This can be written as

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) Break Up your procedure if need be. and call the 2nd procedure from the 1st

5) Avoid using .Select and .Activate They not only make your code slow but also take a lot of space in your code if used extensively. How to avoid using Select in Excel VBA macros

回答2:

Macros size is limited to 64kb, after which you will get an error message from Excel.

I ran into an issue, for which there is no explanation or error message from Excel, where Excel was unable to fully calculate a workbook for want of resources when I wrote a macro that calls multiple other macros.

I am presuming that the sum of the length of all macros in the chain would need to be considered.

文章来源: Getting error Procedure too large in VBA Macros (Excel)