IdentifiantMot de passe
Loading...
Mot de passe oublié ?Je m'inscris ! (gratuit)
Navigation

Inscrivez-vous gratuitement
pour pouvoir participer, suivre les réponses en temps réel, voter pour les messages, poser vos propres questions et recevoir la newsletter

Macros et VBA Excel Discussion :

Optimisation vitesse execution macro


Sujet :

Macros et VBA Excel

Vue hybride

Message précédent Message précédent   Message suivant Message suivant
  1. #1
    Nouveau candidat au Club
    Homme Profil pro
    Inscrit en
    Juin 2012
    Messages
    1
    Détails du profil
    Informations personnelles :
    Sexe : Homme
    Localisation : France

    Informations forums :
    Inscription : Juin 2012
    Messages : 1
    Par défaut Optimisation vitesse execution macro
    Bonjour,

    Ci dessous une macro nommée "SOUSDETAILTYPE" qui n'est pas écrite très élégamment (je l'ai écrite...). Avez vous quelques idées ou quelques corrections faciles à comprendre/apporter pour un débutant pour améliorer la vitesse de traitement ?

    Merci à tous

    Bonne soirée


    Code : Sélectionner tout - Visualiser dans une fenêtre à part
    1
    2
    3
    4
    5
    6
    7
    8
    9
    10
    11
    12
    13
    14
    15
    16
    17
    18
    19
    20
    21
    22
    23
    24
    25
    26
    27
    28
    29
    30
    31
    32
    33
    34
    35
    36
    37
    38
    39
    40
    41
    42
    43
    44
    45
    46
    47
    48
    49
    50
    51
    52
    53
    54
    55
    56
    57
    58
    59
    60
    61
    62
    63
    64
    65
    66
    67
    68
    69
    70
    71
    72
    73
    74
    75
    76
    77
    78
    79
    80
    81
    82
    83
    84
    85
    86
    87
    88
    89
    90
    91
    92
    93
    94
    95
    96
    97
    98
    99
    100
    101
    102
    103
    104
    105
    106
    107
    108
    109
    110
    111
    112
    113
    114
    115
    116
    117
    118
    119
    120
    121
    122
    123
    124
    125
    126
    127
    128
    129
    130
    131
    132
    133
    134
    135
    136
    137
    138
    139
    140
    141
    142
    143
    144
    145
    146
    147
    148
    149
    150
    151
    152
    153
    154
    155
    156
    157
    158
    159
    160
    161
    162
    163
    164
    165
    166
    167
    168
    169
    170
    171
    172
    173
    174
    175
    176
    177
    178
    179
    180
    181
    182
    183
    184
    185
    186
    187
    188
    189
    190
    191
    192
    193
    194
    195
    196
    197
    198
    199
    200
    201
    202
    203
    204
    205
    206
    207
    208
    209
    210
    211
    212
    213
    214
    215
    216
    217
    218
    219
    220
    221
    222
    223
    224
    225
    226
    227
    228
    229
    230
    231
    232
    233
    234
    235
    236
    237
    238
    239
    240
    241
    242
    243
    244
    Sub SOUSDETAILTYPE()
     
        'On declare les variables
        Dim ColonneType As String
        Dim Derniere_Ligne As Single
        Dim FormuleOuvrage As String
        Dim FormuleOuvrageFille As String
        Dim FraisChantier As String
     
     
        'On force les configurations
        Application.ScreenUpdating = False
        Application.DisplayStatusBar = False
        Application.Calculation = xlCalculationManual
        Application.EnableEvents = False
     
        'Activation de la feuille SOUS_DETAILS_TYPES
        ActiveWorkbook.Sheets("SOUS DETAILS TYPES").Activate
     
        'Trouve la derni?re ligne de la feuille ETUDE dans la colonne A
        Derniere_Ligne = Sheets("SOUS DETAILS TYPES").Range("A" & Rows.Count).End(xlUp).Row
     
        'On supprime les quadrillages et donn?es en dehors du tableau
        Range("A3:E1048576").ClearFormats
        Range("G3:XFD1048576").ClearFormats
        Range("A" & Derniere_Ligne + 1 & ":XFD1048576").ClearFormats
        Range("Z1:XFD1048576").ClearContents
        Range("A" & Derniere_Ligne + 1 & ":XFD1048576").ClearContents
     
     
        'On remet en place les quadrillages...
        With Range("A1:Y" & Derniere_Ligne)
            .Borders(xlEdgeLeft).LineStyle = xlContinuous
            .Borders(xlEdgeLeft).ColorIndex = 2
            .Borders(xlEdgeTop).LineStyle = xlContinuous
            .Borders(xlEdgeTop).ColorIndex = 2
            .Borders(xlEdgeBottom).LineStyle = xlContinuous
            .Borders(xlEdgeBottom).ColorIndex = 2
            .Borders(xlEdgeRight).LineStyle = xlContinuous
            .Borders(xlEdgeRight).ColorIndex = 2
            .Borders(xlInsideHorizontal).LineStyle = xlContinuous
            .Borders(xlInsideHorizontal).ColorIndex = 2
            .Borders(xlInsideVertical).LineStyle = xlContinuous
            .Borders(xlInsideVertical).ColorIndex = 2
        End With
     
        'On met en forme les polices en noir et pas en gras...
        Cells.Font.Name = "Garamond"
        Cells.Font.FontStyle = "Normal"
        Cells.Font.Size = 11
        Cells.Font.Strikethrough = False
        Cells.Font.Superscript = False
        Cells.Font.Subscript = False
        Cells.Font.OutlineFont = False
        Cells.Font.Shadow = False
        Cells.Font.Underline = xlUnderlineStyleNone
        Cells.Font.ColorIndex = xlAutomatic
        Cells.Font.TintAndShade = 0
        Cells.Font.ThemeFont = xlThemeFontNone
     
     
        'On traite la premi?re ligne pour la mettre avec une police blanche
        Range("A1:Y1").Font.FontStyle = "Gras"
        Range("A1:Y1").Font.Color = RGB(255, 255, 255)
     
        'On met en forme les format des polices
     
        'Pour les chiffres
        Range("H:H,I:I,S:S").NumberFormat = "#,##0.00_ ;-#,##0.00 "
     
        'Pour les unit?s /J
        Range("J:J").NumberFormat = "0.00""/J"""
     
        'Pour les ?
        Range("K:K,L:L,M:M,P:P,Q:Q,R:R,T:T,U:U,V:V").NumberFormat = "#,##0.00 $"
     
        'Pour les %
        Range("O:O,W:W").NumberFormat = "0%"
     
        '
        '********** ATTENTION DEBUT DE LA BOUCLE **********
        '
        'On parcours le tableau de la gauche vers la droite et du haut vers le bas
        numero = 3
        While numero <= Derniere_Ligne
            ColonneType = Range("A" & numero)
     
            'Commun ? tout les cas, on traite les 3 premi?res colonnes
     
            'On traite le num?ro d'ouvrage
            FormuleOuvrage = Range("A" & numero)
                Select Case FormuleOuvrage
                    Case Is = "O"
                        Range("B" & numero).Formula = "=B" & numero - 1 & "+1"
                    Case Is = "T"
                        Range("B" & numero).Formula = "=B" & numero - 1 & "+1"
                    Case Else
                        Range("B" & numero).Formula = "=B" & numero - 1
                End Select
     
            'On traite le num?ro d'ouvrage fille
            FormuleOuvrageFille = Range("A" & numero)
                Select Case FormuleOuvrageFille
                    Case Is = "N"
                        Range("C" & numero).Formula = "=C" & numero - 1
                    Case Is = "O"
                        Range("C" & numero).Formula = "=0"
                    Case Is = "OF"
                        Range("C" & numero).Formula = "=C" & numero - 1 & "+1"
                    Case Is = "R"
                        Range("C" & numero).Formula = "=C" & numero - 1
                    Case Is = "T"
                        Range("C" & numero).Formula = "=0"
                    Case Else
                        Range("C" & numero).Formula = "=C" & numero - 1
                End Select
     
            'On regroupe l'ouvrage et l'ouvrage fille
            Range("D" & numero).Formula = "=CONCATENATE($B" & numero & ",""."",$C" & numero & ")"
     
            'Maintenant on traite au cas par cas
            Select Case ColonneType
     
                'Les ressources
                Case Is = "R"
                    'Couleur
                    Range("A" & numero & ":Y" & numero).Interior.Color = RGB(213, 248, 216) 'Couleur SIROCO : 213 248 216
                    'Police
                    With Range("J" & numero).Font
                        .FontStyle = "Gras"
                        .ColorIndex = 3
                    End With
                    'M?nage
                    Range("N" & numero & ":Q" & numero & ",T" & numero).ClearContents
                    'Formule
                    Range("F" & numero).Formula = "=IF(ISNA(INDEX(RESSOURCES_BD,MATCH($E" & numero & ",RESSOURCES_CODE,0),MATCH('SOUS DETAILS TYPES'!$F$1,RESSOURCES_LIGNE,0))),""***** ABSENT DE LA BIBLIOTHEQUE *****"",(INDEX(RESSOURCES_BD,MATCH($E" & numero & ",RESSOURCES_CODE,0),MATCH('SOUS DETAILS TYPES'!$F$1,RESSOURCES_LIGNE,0))))"
                    Range("G" & numero).Formula = "=IF(ISNA(INDEX(RESSOURCES_BD,MATCH($E" & numero & ",RESSOURCES_CODE,0),MATCH('SOUS DETAILS TYPES'!$G$1,RESSOURCES_LIGNE,0))),"""",(INDEX(RESSOURCES_BD,MATCH($E" & numero & ",RESSOURCES_CODE,0),MATCH('SOUS DETAILS TYPES'!$G$1,RESSOURCES_LIGNE,0))))"
                    Range("H" & numero).Formula = "=$I" & numero & "*$J" & numero
                    Range("I" & numero).Formula = "=$I" & numero - 1
                    Range("K" & numero).Formula = "=$J" & numero & "*$L" & numero
                    Range("L" & numero).Formula = "=IF(ISNA(INDEX(RESSOURCES_BD,MATCH($E" & numero & ",RESSOURCES_CODE,0),MATCH('SOUS DETAILS TYPES'!$L$1,RESSOURCES_LIGNE,0))),0,(INDEX(RESSOURCES_BD,MATCH($E" & numero & ",RESSOURCES_CODE,0),MATCH('SOUS DETAILS TYPES'!$L$1,RESSOURCES_LIGNE,0))))"
                    Range("M" & numero).Formula = "=$H" & numero & "*$L" & numero
                    Range("R" & numero).Formula = "=IF($J" & numero & "=0,0,(SUMIFS(COLONNE_R,COLONNE_A,""O"",COLONNE_B,$B" & numero & "))/(SUMIFS(COLONNE_M,COLONNE_A,""O"",COLONNE_B,$B" & numero & "))*$M" & numero & ")"
                    Range("S" & numero).Formula = "=SUMIF(SYNTHESE!$D$24:$D$28,(LEFT($F" & numero & ",6)),SYNTHESE!$B$24:$B$28)"
                    Range("U" & numero).Formula = "=$R" & numero & "*$S" & numero
                    Range("V" & numero).Formula = "=$U" & numero & "-$R" & numero
                    Range("W" & numero).Formula = "=IF($U" & numero & "=0,0,$V" & numero & "/$U" & numero & ")"
                    Range("X" & numero).Formula = "=INDEX(RESSOURCES_BD,MATCH($E" & numero & ",RESSOURCES_CODE,0),MATCH('SOUS DETAILS TYPES'!$X$1,RESSOURCES_LIGNE,0))"
                    Range("X" & numero).Formula = "=IF(ISNA(INDEX(RESSOURCES_BD,MATCH($E" & numero & ",RESSOURCES_CODE,0),MATCH('SOUS DETAILS TYPES'!$X$1,RESSOURCES_LIGNE,0))),"""",(INDEX(RESSOURCES_BD,MATCH($E" & numero & ",RESSOURCES_CODE,0),MATCH('SOUS DETAILS TYPES'!$X$1,RESSOURCES_LIGNE,0))))"
     
                'Les ouvrages filles
                Case Is = "OF"
                    'Couleur
                    Range("A" & numero & ":Y" & numero).Interior.Color = RGB(217, 217, 217) 'Couleur SIROCO : Aucune
                    'Police
                    With Range("I" & numero).Font
                        .FontStyle = "Gras"
                        .Color = RGB(255, 0, 0)
                    End With
                    'M?nage
                    Range("E" & numero & ",N" & numero & ":X" & numero).ClearContents
                    'Formule
                    Range("J" & numero).Formula = "=$H" & numero & "/$I" & numero
                    Range("K" & numero).Formula = "=SUMIFS(COLONNE_K,COLONNE_D,$D" & numero & ",COLONNE_A,""R"")"
                    Range("L" & numero).Formula = "=$M" & numero & "/$H" & numero
                    Range("M" & numero).Formula = "=SUMIFS(COLONNE_M,COLONNE_D,$D" & numero & ",COLONNE_A,""R"")"
     
                'Les ouvrages
                Case Is = "O"
                    'Couleur
                    Range("A" & numero & ":Y" & numero).Interior.Color = RGB(213, 217, 248) 'Couleur SIROCO : 213 217 248
                    'Police
                    With Range("I" & numero).Font
                        .FontStyle = "Gras"
                        .Color = RGB(255, 0, 0)
                    End With
                    'M?nage
                    Range("E" & numero & ",X" & numero).ClearContents
                    'Formule
                    Range("J" & numero).Formula = "=$H" & numero & "/$I" & numero
                    Range("K" & numero).Formula = "=SUMIFS(COLONNE_K,COLONNE_B,$B" & numero & ",COLONNE_A,""R"")"
                    Range("L" & numero).Formula = "=IF($H" & numero & "=0,0,$M" & numero & "/$H" & numero & ")"
     
     
                    Range("M" & numero).Formula = "=SUMIFS(COLONNE_M,COLONNE_B,$B" & numero & ",COLONNE_A,""R"")"
                    'Sous programme pour traiter le cas des frais de chantier, si O on touche ? rien, autrement on met N par d?faut
                        FraisChantier = Range("N" & numero)
                        Select Case FraisChantier
                            Case Is = "O"
                            Case Else
                                Range("N" & numero).Formula = "N"
                        End Select
                    'Suite du traitement des formules "classique"
                    Range("O" & numero).Formula = "=IF($N" & numero & "=""O"",$M" & numero & "/SYNTHESE!$B$14,0)"
                    Range("P" & numero).Formula = "=$O" & numero & "*FRAIS_DE_CHANTIER"
                    Range("Q" & numero).Formula = "=IF($H" & numero & "=0,0,$R" & numero & "/$H" & numero & ")"
                    Range("R" & numero).Formula = "=$M" & numero & "+$P" & numero
                    Range("S" & numero).Formula = "=IF($R" & numero & "=0,0,$U" & numero & "/$R" & numero & ")"
                    Range("T" & numero).Formula = "=IF($H" & numero & "=0,0,$U" & numero & "/$H" & numero & ")"
                    Range("U" & numero).Formula = "=SUMIFS(COLONNE_U,COLONNE_B,$B" & numero & ",COLONNE_A,""R"")"
                    Range("V" & numero).Formula = "=$U" & numero & "-$R" & numero
                    Range("W" & numero).Formula = "=IF($U" & numero & "=0,0,$V" & numero & "/$U" & numero & ")"
     
                'Les titres
                Case Is = "T"
                    'Couleur
                    Range("A" & numero & ":Y" & numero).Interior.Color = RGB(248, 213, 248) 'Couleur SIROCO : 248 213 248
                    'M?nage
                    Range("E" & numero & ",G" & numero & ":X" & numero).ClearContents
                    'Formule
     
                'Les notas
                Case Is = "N"
                    'Couleur
                    Range("A" & numero & ":Y" & numero).Interior.Color = RGB(255, 204, 153) 'Couleur SIROCO : 255 204 153
                    'Police
                    With Range("F" & numero).Font
                        .FontStyle = "Gras"
                        .Color = RGB(255, 0, 0)
                    End With
                    'M?nage
                    Range("E" & numero).ClearContents
                    Range("E" & numero & ",G" & numero & ":H" & numero & ",J" & numero & ":X" & numero).ClearContents
                    'Formule
                    Range("I" & numero).Formula = "=$I" & numero - 1
     
                'Les autres cas sont surlign?s en jaune
                Case Else
                    Range("A" & numero & ":Y" & numero).Interior.Color = 65535
            End Select
            numero = numero + 1
        Wend
        '
        '********** ATTENTION FIN DE LA BOUCLE **********
        '
        'On r?tablit les configurations
        Application.ScreenUpdating = True
        Application.DisplayStatusBar = True
        Application.Calculation = xlCalculationAutomatic
        Application.EnableEvents = True
     
        MsgBox "Mise ? jour termin?e."
     
    End Sub

  2. #2
    Expert confirmé Avatar de Patrice740
    Homme Profil pro
    Retraité
    Inscrit en
    Mars 2007
    Messages
    2 478
    Détails du profil
    Informations personnelles :
    Sexe : Homme
    Âge : 71
    Localisation : France, Gironde (Aquitaine)

    Informations professionnelles :
    Activité : Retraité
    Secteur : Aéronautique - Marine - Espace - Armement

    Informations forums :
    Inscription : Mars 2007
    Messages : 2 478
    Par défaut
    Bonjour,

    A mon avis, utiliser des formules différentes selon le contenu d'une cellule est une mauvaise méthode.
    Il est préférable qu'une cellule donnée contienne toujours la même formule quelque soit le contenu des autres cellules : il suffit que la formule tienne compte des différentes possibilités. Il est alors possible de l'écrire sans faire de boucle (avec FormulaR1C1)

Discussions similaires

  1. [XL-2007] Optimisation temps execution d'une macro
    Par Ltspitfire dans le forum Macros et VBA Excel
    Réponses: 23
    Dernier message: 22/01/2015, 15h18
  2. Optimisation & Vitesse d'execution ?
    Par MaXOhBalle dans le forum PHP & Base de données
    Réponses: 1
    Dernier message: 16/09/2009, 09h44
  3. optimisation vitesse
    Par WaM dans le forum C
    Réponses: 7
    Dernier message: 09/01/2006, 23h43
  4. Réponses: 4
    Dernier message: 19/05/2005, 11h51

Partager

Partager
  • Envoyer la discussion sur Viadeo
  • Envoyer la discussion sur Twitter
  • Envoyer la discussion sur Google
  • Envoyer la discussion sur Facebook
  • Envoyer la discussion sur Digg
  • Envoyer la discussion sur Delicious
  • Envoyer la discussion sur MySpace
  • Envoyer la discussion sur Yahoo