Getting error Procedure too large in VBA Macros (Excel)

前端 未结 2 1662
耶瑟儿~
耶瑟儿~ 2020-11-27 07:28

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

I am using MS-Excel 2003.

相关标签:
2条回答
  • 2020-11-27 08:05

    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.

    0 讨论(0)
  • 2020-11-27 08:07

    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

    0 讨论(0)
提交回复
热议问题