1 votes

Code itérant lentement

J'ai une macro simple qui crée 16 versions différentes d'un modèle, en mettant à jour en obtenant des valeurs d'un autre classeur ouvert. Cela prend plus d'une minute pour itérer seulement 16 fois et je me demandais s'il y avait un moyen d'accélérer le processus ? Cela va devenir un problème parce que j'ai besoin de l'itérer 64+ fois.

J'ai le sentiment que la raison pour laquelle mon code est lent est que j'accède trop souvent aux feuilles de calcul dans mes boucles. J'ai également cherché à réduire le nombre de comparaisons de chaînes de caractères, mais cela n'a pas semblé faire une grande différence.

Merci

Sub getORSA()
Application.ScreenUpdating = False

Dim wb As Workbook, template As Workbook
Dim ws As Worksheet, ws2 As Worksheet
Dim scenario As Variant, scenario2 As Variant, division As Variant, analysis As Variant
Dim a As Variant, b As Variant, c As Variant, confirm As Variant
Dim iterations As Integer
Dim templatePath As String, path As String, name As String, extension As String
Dim result As String
Dim timeOn As Date, timeOff As Date

'check the user wants to run script
confirm = MsgBox("Run ORSA script?", vbYesNo)
If confirm = vbNo Then
    Exit Sub
End If

timeOn = Now

'initialise variables & objects
Set wb = ThisWorkbook
Set ws = wb.Worksheets("T.change")
scenario = Array("Base") ' while testing use just one scenario
scenario2 = Array("Base", "Base (2)", "Inflation", "Deflation")
division = Array("LGAS SHF", "LGPL SHF", "SRC", "FINANCE")
analysis = Array("GROUP EC", "GROUP SII", "LGAS EC", "LGAS SII")

'template variables and open template
templatePath = "\\..."
path = "\\..."
name = "ORSA_"
extension = ".xlsx"
Set template = Workbooks.Open(Filename:=templatePath)

iterations = 0

    For Each a In scenario
        For Each b In division
            For Each c In analysis

                'update values on template
                With template.Worksheets("EB")

                    ' --SET HEADERS ON TEMPLATE -- '

                    .Range("C2").value = Trim(Right(c, 3))
                    .Range("G2").value = a
                    .Range("C4").value = "LGC"

                    Select Case b
                        Case "LGAS SHF", "SRC"
                            .Range("E4").value = "LGAS"
                        Case "LGPL SHF"
                            .Range("E4").value = "LGPL"
                        Case "FINANCE"
                            .Range("E4").value = "FIN PLC"
                     End Select

                    .Range("G4").value = "LGC"

                    Select Case b
                        Case "LGAS SHF", "LGPL SHF"
                            .Range("I4").value = "SHF"
                        Case "SRC"
                            .Range("I4").value = "SRC"
                        Case "FINANCE"
                            .Range("I4").value = "FIN_PLC"
                    End Select

                    ' -- SET VALUES ON TEMPLATE -- '

                    'update dropdowns of T.change tab
                    ws.Range("B1").value = a
                    ws.Range("B2").value = b
                    ws.Range("B3").value = c

                    Dim investmentReturn As Range
                    Dim capitalTransfer As Range
                    Dim cashSurplus As Range
                    Dim ifrsProfit As Range
                    Dim assets As Range

                    Set investmentReturn = ws.Range("C62:I62")
                    Set capitalTransfer = ws.Range("C64:I64")
                    Set cashSurplus = ws.Range("C65:I65")
                    Set ifrsProfit = ws.Range("C66:I66")
                    Set assets = ws.Range("C67:I72")

                    .Range("D17:J17").value = investmentReturn.value
                    .Range("D30:J30").value = capitalTransfer.value
                    .Range("D34:J34").value = cashSurplus.value
                    .Range("D46:J46").value = ifrsProfit.value
                    .Range("D52:J57").value = assets.value

                End With

                'save and close the template file
                template.SaveAs _
                Filename:=path & name & a & " - " & b & " - " & c & extension, _
                FileFormat:=xlOpenXMLWorkbook, CreateBackup:=False

                iterations = iterations + 1
            Next c
        Next b
    Next a

template.Close

timeOff = Now - timeOn

MsgBox ("Successfully ran " & iterations & " iterations" & vbNewLine _
    & "Time: " & Format(timeOff, "hh:mm:ss"))

Application.ScreenUpdating = True
End Sub

Pour plus de clarté, cet extrait est essentiel, car il modifie les valeurs de ma feuille maîtresse en fonction des valeurs qui doivent être saisies dans chaque version du modèle :

'update dropdowns of T.change tab
ws.Range("B1").value = a
ws.Range("B2").value = b
ws.Range("B3").value = c

Merci

0 votes

Je me suis renseigné, j'ai trouvé le SELECT plus lisible. Je les ai échangés contre IF et n'a pas particulièrement vu une amélioration de la vitesse

1 votes

C'est normal. À part la désactivation des calculs, je ne vois rien d'autre à faire ici, sauf peut-être utiliser moins de variables et plus de code en dur, si les variables utilisent des ressources système. Regardez peut-être cette Q/A pour voir si cela vous affecte.

0 votes

Merci @Raystafarian, j'ai désactivé le calcul automatique et utilisé calculate au seul endroit où j'en avais besoin et c'est maintenant 3x plus rapide. Bonne suggestion ! Maintenant, je me demande où d'autre il calculait, car je ne m'attendais qu'à un seul calcul.

1voto

Raystafarian Points 21292

Utilisez ceci avant que le code ne commence

 Application.ScreenUpdating = False
 Application.Calculation = xlCalculationManual

et utiliser ceci avant la fin du sous-marin

 Application.ScreenUpdating = True
 Application.Calculation = xlCalculationAutomatic

Sans voir le reste de votre code, je ne comprends pas bien pourquoi vous assignez des valeurs à des plages codées en dur après le début des boucles. Elles changeraient à chaque boucle ou est-ce que vous bouclez à travers des classeurs/feuilles ?

0 votes

Merci pour votre réponse, je peux ajouter le reste du code si vous pensez que cela peut aider. J'ai utilisé Application.ScreenUpdating = False, mais pas le calcul manuel puisque j'ai besoin du calcul (en théorie). J'ai un ws qui a des valeurs changeantes basées sur trois dropdowns. Je dois mettre à jour ces listes déroulantes à chaque itération, puis utiliser les nouvelles valeurs de ce ws pour remplir chaque instance du modèle. Faites-moi savoir si vous voulez toujours le reste du code.

0 votes

@CallumDS33 pouvez-vous désactiver le calcul au début de l'exécution, puis le réactiver avant de sauvegarder ? Oui, l'affichage de la sous-routine entière faciliterait le remaniement.

0 votes

J'ai ajouté le reste. Si je désactivais le calcul, j'aurais sans doute besoin d'un calculate après ws.Range("B3").value = c de façon à ce que les valeurs de mon ws de recherche soient mises à jour, puisque j'utilise les valeurs mises à jour plus bas dans le ws. Set investmentReturn = ...

0voto

agtoever Points 6124

Vous pouvez ignorer VBA et essayer de résoudre le problème avec Microsoft Power Query, comme je l'ai expliqué dans la réponse à cette question SU sur la fusion des tableaux Excel.

SistemesEz.com

SystemesEZ est une communauté de sysadmins où vous pouvez résoudre vos problèmes et vos doutes. Vous pouvez consulter les questions des autres sysadmins, poser vos propres questions ou résoudre celles des autres.

Powered by:

X