Performance VBA

Bonjour,

J'ai plusieurs fichiers Excel qui roulent les même macros VBA.

Quand j'ouvre Excel pour la première fois et que j'exécute mon premier ficher je note que le temps d'exécution est de 0.75 secondes. Je laisse mon fichier ouvert.

Quand j'ouvre mon deuxième fichier et que j'exécute les macros et je reviens à mon premier ficher et j'exécute à nouveau les macros le temps d'exécution passe de 1.45 secondes.

Si je ferme Excel et j'ouvre à nouveau mon premier fichier le temps d'exécution revient à 0.75 secondes.

Qu'est qui explique ce phénomène?

Merci,

Oiseau bleu

Hello,

Combien de fichier sont ouverts à 1,45 vs combien sont ouverts à 0,75 ?

Bonjour,

tu demandes de la divination...
Quelles sont les macros de ton 2nd fichier ?
Met un Stop au début de chaque, en commençant par les fonctions personnalisées s'il y en a. Tu en as peut-être qui se déclenchent.

Sinon ça peut-être un manque mémoire si les fichiers sont gros, et tu passe en mémoire virtuelle (sur le HD)
eric

Bonjour,

J'utilise 2 fichiers identiques. Simplement version 1 et version 2 et ils contiennent exactement le même code VBA.

J'ouvre le premier et l'exécution est de 0.78 secondes.

J'ouvre le deuxième et l'exécution passe à 1.42 secondes.

Il y a juste les 2 fichiers Excel qui sont ouverts rien d'autres.

Voici la partie du code VBA que j'exécute.

Option Explicit
    Dim cell As Range, fd As Worksheet, tablo, tabloR()
    Dim Detail_Desc As String
    Dim Desc_CA As String
    Dim nonglet As String
    Dim lnrev As Long
    Dim rg1 As Range
    Dim timerAvant
    Dim derLn1&, derln2&, derLn3&, derLn4&, derLn5&, dte, i&, j&, k&, m&, flag&
Private Sub Worksheet_SelectionChange(ByVal Target As Range)

    timerAvant = Timer
    If Target.Count <> 3 Or Target.Row = 2 Then Exit Sub
    Arret_Calcul
    ActiveSheet.Unprotect Password:=Cache.Range("A1")
    nonglet = ActiveSheet.Name

    If Target.Row >= Range("LigneCA_Debut").Row And Target.Row <= Range("LigneCA_Fin").Row Then
        Call Traiter_Chiffre_Affaire(Target)
    End If
    Demarre_Calcul
    MsgBox "Temps d'exécution : " & Timer - timerAvant & " secondes."
    Set cell = Nothing
    Set fd = Nothing
    Set tablo = Nothing

    ActiveSheet.Protect Password:=Cache.Range("A1"), DrawingObjects:=True, Contents:=True, Scenarios:=True _
        , AllowFormattingCells:=True, AllowFormattingColumns:=True, _
        AllowFormattingRows:=True, AllowFiltering:=True
End Sub
Sub Traiter_Chiffre_Affaire(Target As Range)

    derLn1 = Range("C" & Target.Row).Row + 1

    If Not Intersect(Target, Range("LigneCA_Debut:C" & derLn1)) Is Nothing Then
        If Shapes.Range("BBAnGrp").Visible = True Then
            ActiveSheet.Shapes.Range(Array("BBAnGrp")).Select
            Selection.Placement = xlMove
            ActiveSheet.Shapes.Range(Array("FCAAnGrp")).Select
            Selection.Placement = xlMove
            ActiveSheet.Shapes.Range(Array("EBNAnGrp")).Select
            Selection.Placement = xlMove
        End If
        Cells.EntireRow.Hidden = False
        If Shapes.Range("BBAnGrp").Visible = True Then
            ActiveSheet.Shapes.Range(Array("BBAnGrp")).Select
            Selection.Placement = xlFreeFloating
            ActiveSheet.Shapes.Range(Array("FCAAnGrp")).Select
            Selection.Placement = xlFreeFloating
            ActiveSheet.Shapes.Range(Array("EBNAnGrp")).Select
            Selection.Placement = xlFreeFloating
        End If
        Indicateurs.Shapes("Image BB_O").Visible = True
        Indicateurs.Shapes("Image BB_F").Visible = True
        Indicateurs.Shapes("Image FCA_O").Visible = True
        Indicateurs.Shapes("Image FCA_F").Visible = True
        Indicateurs.Shapes("BBAnGrp").Visible = True
        Indicateurs.Shapes("FCAAnGrp").Visible = True
        Indicateurs.Shapes("EBNAnGrp").Visible = True
        Cells(Target.Row, 1).Select

        If k > 0 Then Set cell = Range("BA:BA").Find(Desc_CA, lookat:=xlWhole)

        If Not cell Is Nothing Then
            derln2 = cell.Row
            derLn3 = Range("C" & Rows.Count).End(xlUp).Row
            Rows(derln2 - 5 & ":" & derLn3 + 10).Delete Shift:=xlUp
            Indicateurs.Shapes("Affaire_Activite1_Btn").Visible = True
            Indicateurs.Shapes("Affaire_Activite2_Btn").Visible = True
            Indicateurs.Shapes("Affaire_Activite3_Btn").Visible = True
            Indicateurs.Shapes("Affaire_Activite5_Btn").Visible = True
            Indicateurs.Shapes("Affaire_Activite4_Btn").Visible = True
            Indicateurs.Shapes("Affaire_Total_Btn").Visible = True
            Indicateurs.Shapes("Contribution_Activite1_Btn").Visible = True
            Indicateurs.Shapes("Contribution_Activite2_Btn").Visible = True
            Indicateurs.Shapes("Contribution_Activite3_Btn").Visible = True
            Indicateurs.Shapes("Contribution_Activite5_Btn").Visible = True
            Indicateurs.Shapes("Contribution_Activite4_Btn").Visible = True
            Indicateurs.Shapes("Contribution_Total_Btn").Visible = True
        Else
            Indicateurs.Shapes("Affaire_Activite1_Btn").Visible = False
            Indicateurs.Shapes("Affaire_Activite2_Btn").Visible = False
            Indicateurs.Shapes("Affaire_Activite3_Btn").Visible = False
            Indicateurs.Shapes("Affaire_Activite5_Btn").Visible = False
            Indicateurs.Shapes("Affaire_Activite4_Btn").Visible = False
            Indicateurs.Shapes("Affaire_Total_Btn").Visible = False
            Indicateurs.Shapes("Contribution_Activite1_Btn").Visible = False
            Indicateurs.Shapes("Contribution_Activite2_Btn").Visible = False
            Indicateurs.Shapes("Contribution_Activite3_Btn").Visible = False
            Indicateurs.Shapes("Contribution_Activite5_Btn").Visible = False
            Indicateurs.Shapes("Contribution_Activite4_Btn").Visible = False
            Indicateurs.Shapes("Contribution_Total_Btn").Visible = False
            If Range("C" & Target.Row).Row = Range("LigneCA_Debut").Row Then
                Desc_CA = EtatFinancier.Range("EF_Revenus_Activite1").Value
                Indicateurs.Shapes("Affaire_Activite1_Btn").Visible = True
            ElseIf Range("C" & Target.Row).Row = Range("LigneCA_Debut").Row + 1 Then
                Desc_CA = EtatFinancier.Range("EF_Revenus_Activite2").Value
                Rows(derLn1 - 2).EntireRow.Hidden = True
                Indicateurs.Shapes("Affaire_Activite2_Btn").Visible = True
            ElseIf Range("C" & Target.Row).Row = Range("LigneCA_Debut").Row + 2 Then
                Desc_CA = EtatFinancier.Range("EF_Revenus_Activite3").Value
                Rows(derLn1 - 3 & ":" & derLn1 - 2).EntireRow.Hidden = True
                Indicateurs.Shapes("Affaire_Activite3_Btn").Visible = True
            ElseIf Range("C" & Target.Row).Row = Range("LigneCA_Debut").Row + 3 Then
                Desc_CA = EtatFinancier.Range("EF_Revenus_Activite4").Value
                Rows(derLn1 - 4 & ":" & derLn1 - 2).EntireRow.Hidden = True
                Indicateurs.Shapes("Affaire_Activite4_Btn").Visible = True
            ElseIf Range("C" & Target.Row).Row = Range("LigneCA_Debut").Row + 4 Then
                Desc_CA = EtatFinancier.Range("EF_Revenus_Activite5").Value
                Rows(derLn1 - 5 & ":" & derLn1 - 2).EntireRow.Hidden = True
                Indicateurs.Shapes("Affaire_Activite5_Btn").Visible = True
            Else
                Application.EnableEvents = True
                Exit Sub
            End If
        derLn4 = Range("C" & Rows.Count).End(xlUp).Row + 200
        Rows(derLn1 & ":" & derLn4).EntireRow.Hidden = True
        Indicateurs.Shapes("Image BB_O").Visible = False
        Indicateurs.Shapes("Image BB_F").Visible = False
        Indicateurs.Shapes("Image BB_F").Visible = False
        Indicateurs.Shapes("Image FCA_O").Visible = False
        Indicateurs.Shapes("Image FCA_F").Visible = False
        Indicateurs.Shapes("BBAnGrp").Visible = False
        Indicateurs.Shapes("FCAAnGrp").Visible = False
        Indicateurs.Shapes("EBNAnGrp").Visible = False

        dte = Desc_CA
        Set fd = BVAnalyse
        tablo = fd.Range("PREMIER_COMPTE_BV" & ":DERNIER_COMPTE_BV")
        k = 0

        For i = 1 To UBound(tablo, 1)
            If tablo(i, 6) = dte Then
                ReDim Preserve tabloR(1 To 6, 1 To k + 1)
                For j = 1 To 6
                    tabloR(j, 1 + k) = tablo(i, j)
                Next j
                k = k + 1
            End If
        Next i

        derLn3 = k
        derLn5 = derLn4 + 2

        If k > 0 Then Range("C" & derLn5).Resize(UBound(tabloR, 2), 6) = Application.Transpose(tabloR)
            If Range("C" & derLn5).Value = "" Then
                Cells.EntireRow.Hidden = False
                Indicateurs.Shapes("Image BB_O").Visible = True
                Indicateurs.Shapes("Image BB_F").Visible = True
                Indicateurs.Shapes("Image FCA_O").Visible = True
                Indicateurs.Shapes("Image FCA_F").Visible = True
                Indicateurs.Shapes("BBAnGrp").Visible = True
                Indicateurs.Shapes("FCAAnGrp").Visible = True
                Indicateurs.Shapes("EBNAnGrp").Visible = True
                Indicateurs.Shapes("Affaire_Activite1_Btn").Visible = True
                Indicateurs.Shapes("Affaire_Activite2_Btn").Visible = True
                Indicateurs.Shapes("Affaire_Activite3_Btn").Visible = True
                Indicateurs.Shapes("Affaire_Activite5_Btn").Visible = True
                Indicateurs.Shapes("Affaire_Activite4_Btn").Visible = True
                Indicateurs.Shapes("Affaire_Total_Btn").Visible = True
                Indicateurs.Shapes("Contribution_Activite1_Btn").Visible = True
                Indicateurs.Shapes("Contribution_Activite2_Btn").Visible = True
                Indicateurs.Shapes("Contribution_Activite3_Btn").Visible = True
                Indicateurs.Shapes("Contribution_Activite5_Btn").Visible = True
                Indicateurs.Shapes("Contribution_Activite4_Btn").Visible = True
                Indicateurs.Shapes("Contribution_Total_Btn").Visible = True
            Else
                Set rg1 = Range("C" & derLn5 & ":C" & derLn5 + k)
                With rg1.Font
                    .Name = "Arial"
                    .Size = 11
                End With
                Set rg1 = Range("D" & derLn5 & ":D" & derLn5 + k)
                With rg1.Font
                    .Name = "Calibri"
                    .Size = 10
                End With
                Range("E" & derLn5 & ":G" & derLn5 + k).ClearContents
                Range("H" & derLn5 & ":H" & derLn5 + k).Cut Range("BA" & derLn5 & ":BA" & derLn5 + k)
                Range("IND_CA_Formule").Copy Range("F" & derLn5 - 1)

                m = k - 1
                Range("F" & derLn5 & ":AB" & derLn5).Copy Range("F" & derLn5 + 1 & ":AB" & derLn5 + m)
                Range("Revenus_Format").Copy
                Range("F" & derLn5 - 1 & ":AB" & derLn5 + m + 1).PasteSpecial Paste:=xlPasteFormats
                Application.CutCopyMode = False
                Set rg1 = Range("F" & derLn5 - 1 & ":AB" & derLn5 + m + 1)
                With rg1.Font
                     .Name = "Arial"
                     .Size = 10
                 End With
                 With rg1
                     .HorizontalAlignment = xlRight
                     .VerticalAlignment = xlBottom
                     .WrapText = False
                     .Orientation = 0
                     .AddIndent = False
                     .IndentLevel = 0
                     .ShrinkToFit = False
                     .ReadingOrder = xlContext
                     .MergeCells = False
                 End With
                 Range("D" & derLn5 + m + 1) = "Total"
                 Range("F" & derLn5 + m + 1).FormulaLocal = "=somme(F" & derLn5 & ":F" & derLn5 + m & ")"
                 Range("G" & derLn5 + m + 1).FormulaLocal = "=somme(G" & derLn5 & ":G" & derLn5 + m & ")"
                 Range("H" & derLn5 + m + 1).FormulaLocal = "=somme(H" & derLn5 & ":H" & derLn5 + m & ")"
                 Range("I" & derLn5 + m + 1).FormulaLocal = "=somme(I" & derLn5 & ":I" & derLn5 + m & ")"
                 Range("J" & derLn5 + m + 1).FormulaLocal = "=SIERREUR(I" & derLn5 + m + 1 & "/G" & derLn5 + m + 1 & ";0)"
                 Range("K" & derLn5 + m + 1).FormulaLocal = "=somme(K" & derLn5 & ":K" & derLn5 + m & ")"
                 Range("L" & derLn5 + m + 1).FormulaLocal = "=SIERREUR(K" & derLn5 + m + 1 & "/H" & derLn5 + m + 1 & ";0)"
                 Set rg1 = Range("F" & derLn5 + m + 1 & ":L" & derLn5 + m + 1)
                 With rg1.Borders(xlEdgeTop)
                     .LineStyle = xlContinuous
                     .ColorIndex = xlAutomatic
                     .TintAndShade = 0
                     .Weight = xlThin
                 End With
                 With rg1.Borders(xlEdgeBottom)
                     .LineStyle = xlContinuous
                     .ColorIndex = xlAutomatic
                     .TintAndShade = 0
                     .Weight = xlMedium
                 End With
                 Range("N" & derLn5 + m + 1).FormulaLocal = "=somme(N" & derLn5 & ":N" & derLn5 + m & ")"
                 Range("O" & derLn5 + m + 1).FormulaLocal = "=somme(O" & derLn5 & ":O" & derLn5 + m & ")"
                 Range("P" & derLn5 + m + 1).FormulaLocal = "=somme(P" & derLn5 & ":P" & derLn5 + m & ")"
                 Range("Q" & derLn5 + m + 1).FormulaLocal = "=somme(Q" & derLn5 & ":Q" & derLn5 + m & ")"
                 Range("R" & derLn5 + m + 1).FormulaLocal = "=SIERREUR(Q" & derLn5 + m + 1 & "/O" & derLn5 + m + 1 & ";0)"
                 Range("S" & derLn5 + m + 1).FormulaLocal = "=somme(S" & derLn5 & ":S" & derLn5 + m & ")"
                 Range("T" & derLn5 + m + 1).FormulaLocal = "=SIERREUR(S" & derLn5 + m + 1 & "/P" & derLn5 + m + 1 & ";0)"
                 Set rg1 = Range("N" & derLn5 + m + 1 & ":T" & derLn5 + m + 1)
                 With rg1.Borders(xlEdgeTop)
                     .LineStyle = xlContinuous
                     .ColorIndex = xlAutomatic
                     .TintAndShade = 0
                     .Weight = xlThin
                 End With
                 With rg1.Borders(xlEdgeBottom)
                     .LineStyle = xlContinuous
                     .ColorIndex = xlAutomatic
                     .TintAndShade = 0
                     .Weight = xlMedium
                 End With
                 Range("V" & derLn5 + m + 1).FormulaLocal = "=somme(V" & derLn5 & ":V" & derLn5 + m & ")"
                 Range("W" & derLn5 + m + 1).FormulaLocal = "=somme(W" & derLn5 & ":W" & derLn5 + m & ")"
                 Range("X" & derLn5 + m + 1).FormulaLocal = "=somme(X" & derLn5 & ":X" & derLn5 + m & ")"
                 Range("Y" & derLn5 + m + 1).FormulaLocal = "=somme(Y" & derLn5 & ":Y" & derLn5 + m & ")"
                 Range("Z" & derLn5 + m + 1).FormulaLocal = "=somme(Z" & derLn5 & ":Z" & derLn5 + m & ")"
                 Range("AA" & derLn5 + m + 1).FormulaLocal = "=somme(AA" & derLn5 & ":AA" & derLn5 + m & ")"
                 Set rg1 = Range("V" & derLn5 + m + 1 & ":AA" & derLn5 + m + 1)
                 With rg1.Borders(xlEdgeTop)
                     .LineStyle = xlContinuous
                     .ColorIndex = xlAutomatic
                     .TintAndShade = 0
                     .Weight = xlThin
                 End With
                 With rg1.Borders(xlEdgeBottom)
                     .LineStyle = xlContinuous
                     .ColorIndex = xlAutomatic
                     .TintAndShade = 0
                     .Weight = xlMedium
                 End With

                 Set rg1 = Range("B" & derLn5 - 1 & ":B" & derLn5 + m + 3)
                 With rg1.Borders(xlEdgeLeft)
                     .LineStyle = xlContinuous
                     .ColorIndex = xlAutomatic
                     .TintAndShade = 0
                     .Weight = xlMedium
                 End With
                 Set rg1 = Range("B" & derLn5 + m + 1 & ":AD" & derLn5 + m + 3)
                 With rg1.Borders(xlEdgeBottom)
                     .LineStyle = xlContinuous
                     .ColorIndex = xlAutomatic
                     .TintAndShade = 0
                     .Weight = xlMedium
                 End With
                 Set rg1 = Range("AC" & derLn5 - 1 & ":AC" & derLn5 + m + 3)
                 With rg1.Borders(xlEdgeRight)
                     .LineStyle = xlContinuous
                     .ColorIndex = xlAutomatic
                     .TintAndShade = 0
                     .Weight = xlMedium
                 End With
                 Set rg1 = Range("AD" & derLn5 - 1 & ":AD" & derLn5 + m + 3)
                 With rg1.Borders(xlEdgeRight)
                     .LineStyle = xlContinuous
                     .ColorIndex = xlAutomatic
                     .TintAndShade = 0
                     .Weight = xlMedium
                 End With

                 Cells(Target.Row, 1).Select
               End If
            End If
        End If
End Sub
Sub Demarre_Calcul()
    With Application
        .EnableEvents = True
        .Calculation = xlCalculationAutomatic
        .ScreenUpdating = True
    End With
End Sub

Sub Arret_Calcul()
    With Application
        .EnableEvents = False
        .Calculation = xlCalculationManual
        .ScreenUpdating = False
    End With
End Sub

Il y a sûrement quelques chose que je fais de travers dans mon code ou que je ne réinitialise pas correctement???

Merci,

Oiseau bleu

Bonjour,

rien qui saute aux yeux dans ton code.
Si tu lances 2 fois sans ouvrir le 2nd fichier, le temps reste constant ?
Le temps augmente dans le 1er même si tu ouvres le 2nd sans y lancer la macro ?
Quelle taille font-il ?
eric

Oui, le temps demeure constant, il y a des petites variations de 0.75 à 0.81 quand j'ai un seul fichier que j'exécute plusieurs fois.

Quand j'ai 2 fichiers cela peux aller de 1.39 à 1.46 quand j'exécute un ou l'autre des fichiers.

Aussitôt que j'ouvre un deuxième fichier le temps d'exécution augmente.

Est-ce le fais que j'ai les même variables ??

Qu'il y a de l'espace mémoire qui n'est pas bien nettoyé?

Les fichiers font 3 433 Ko chacun puisque se sont les même avec des noms différents que je lance.

Merci,

Oiseau bleu

Bonjour,

en collant ton code dans un module j'y ai vu plus clair.
.Calculation = xlCalculationAutomatic
est une propriété de l'application.
J'ai dans l'idée que tu lances le recalcul de tous les classeurs.

Ca te fait vraiment un gain de passer en manuel (tester avec un seul classeur) ? Je suis dubitatif...
Si tu restes en auto, seules les formules à ré-évaluer seront calculées. De toute façon elles doivent l'être à un moment ou un autre.
Et ce n'est pas les 6 petites formules ajoutées qui change quelque chose.

Si tu constates un gain (?), essaie plutôt avec ActiveSheet.EnableCalculation = False (comme tu lances sur un événement feuille, elle est active)
Le passage à True entrainera le recalcul de toutes les formules (même celles qui n'auraient pas dû l'être), mais que de la feuille.
A voir si tu es gagnant.
eric

Bonjour,

J'ai fait des tests avec les nouvelles informations que vous m'avez fait parvenir.

Quand j'exécute un fichier le temps de calcul : 1.42 secondes

Quand j'exécute avec un autre fichier ouvert sans exécuter ce deuxième fichier et je continue à exécuter le premier fichier le temps de calcul est de 2.60 secondes

Voici le code :

Private Sub Worksheet_SelectionChange(ByVal Target As Range)

    Indicateurs.EnableCalculation = False
    timerAvant = Timer
    If Target.Count <> 3 Or Target.Row = 2 Then Exit Sub
 '   Arret_Calcul
    With Application
        .EnableEvents = False
        .ScreenUpdating = False
    End With

    ActiveSheet.Unprotect Password:=Cache.Range("A1")
    nonglet = ActiveSheet.Name

    If Target.Row >= Range("LigneCA_Debut").Row And Target.Row <= Range("LigneCA_Fin").Row Then
        Call Traiter_Chiffre_Affaire(Target)
    End If
'    Demarre_Calcul
    Indicateurs.EnableCalculation = True
    With Application
        .EnableEvents = True
        .ScreenUpdating = True
    End With

    MsgBox "Temps d'exécution : " & Timer - timerAvant & " secondes."
    Set cell = Nothing
    Set fd = Nothing
    Set tablo = Nothing

    ActiveSheet.Protect Password:=Cache.Range("A1"), DrawingObjects:=True, Contents:=True, Scenarios:=True _
        , AllowFormattingCells:=True, AllowFormattingColumns:=True, _
        AllowFormattingRows:=True, AllowFiltering:=True
End Sub

J'ai mis en commentaire Arret_Calcul et Demarre_Calcul.

J'espère avoir bien suivi vos recommandations.

Est-il possible de passer en calcul manuel pour un onglet seulement et de le remettre automatique après l'exécution de la macro?

Merci à l'avance,

Oiseau bleu

Bonjour,

Est-il possible de passer en calcul manuel pour un onglet seulement et de le remettre automatique après l'exécution de la macro?

oui, et je te l'expliquais dans mon post précédent...

Mais ça ne changera rien puisque tu doubles ton temps même en laissant calcul auto.
Et tu n'as pas répondu non plus à une de mes premières questions : des fonctions personnalisées volatiles ?

Autre question qui me vient : des MFC ? C'est volatile aussi.
Vu la taille des fichiers, on peut exclure le passage en mémoire virtuelle. Sans fichier de test pour essayer de voir ce qui se passe, je n'ai pas d'autres idées
eric

Bonjour,

SI je reste en calcul automatique pour un fichier le est de 2.90 secondes

Avec 2 fichiers d'ouverts le temps passe à 4.15 secondes.

Merci,

Oiseau bleu

Bonjour,

ok. Comme tu n'as pas l'air décidé à répondre aux questions, on va s'arrêter là.
Bonne continuation.
eric

Rechercher des sujets similaires à "performance vba"