Получение ошибки Процедура слишком велика в макросах VBA (Excel)

Ответ 1

Вы получите эту ошибку, если ваша процедура больше 64 КБ. Вот некоторые из вещей, которые вы можете скомбинировать свой код.

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 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 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 Они не только делают ваш код медленным, но и занимают много места в вашем коде, если его использовать широко. Как избежать использования выбора в макросах Excel VBA

Ответ 2

Размер макросов ограничен до 64 КБ, после чего вы получите сообщение об ошибке из Excel.

У меня возникла проблема, для которой в Excel нет объяснений или сообщений об ошибке, когда Excel не смог полностью вычислить книгу из-за нехватки ресурсов, когда я написал макрос, который вызывает несколько других макросов.

Я предполагаю, что сумма длины всех макросов в цепочке должна быть рассмотрена.