Obtention d'une erreur Procédure trop importante dans les macros VBA (Excel)

Question

Je reçois Procedure too Large Error dans une macro VBA.

J'utilise MS-Excel 2003.

Answer 1

Vous obtiendrez cette erreur si votre procédure est supérieure à 64kb. Voici quelques-unes des choses que vous pouvez faire pour compacter votre code

1) Débarrassez-vous du code répétitif. Voir cet exemple

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

Ce code peut être écrit comme suit

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

Un autre exemple

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

Ce code peut être écrit comme suit

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

Cela vous permettra d'économiser de l'espace et de ne pas écrire de code répétitif.

2) Si vous avez généré le code via la macro, vous pouvez obtenir quelque chose comme ceci. Débarrassez-vous du code inutile comme 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

Ce qui précède peut être écrit comme suit

'~~> 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) Déclarez vos objets afin de ne pas avoir à les répéter sans cesse. Voir cet exemple

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

On peut l'écrire comme suit

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) Divisez votre procédure si nécessaire. et appelez la 2ème procédure à partir de la 1ère.

5) Évitez d'utiliser .Select y .Activate Non seulement ils ralentissent votre code, mais ils prennent aussi beaucoup de place dans votre code s'ils sont utilisés de manière intensive. Comment éviter d'utiliser Select dans les macros Excel VBA

Answer 2

La taille des macros est limitée à 64kb, après quoi vous recevrez un message d'erreur d'Excel.

J'ai rencontré un problème, pour lequel il n'y a pas d'explication ou de message d'erreur d'Excel, où Excel n'a pas pu calculer entièrement un classeur par manque de ressources lorsque j'ai écrit une macro qui appelle plusieurs autres macros.

Je présume que la somme de la longueur de toutes les macros de la chaîne devrait être prise en compte.