Optimisation d'un code contenant plusieurs else if

Version imprimable

Bonsoir chers développeurs ,

SVP j'ai une macro qui me permet de colorer des cases dans un tableau à partir des résultats issus d'un autre tableau ,

Mon problème c'est que la plage du deuxième tableau à colorier est beaucoup plus grande, du coup l'exécution de la macro prend un certain retard,

donc j'aimerai bien optimiser le code si c possible pour le rendre efficace, je ne sais pas si c exactement à cause de plusieurs conditions , si je dois faire select case au liieu de if else if ..., si oui comment ?

Code:

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
Sub Colorier_MapResponsibility()
    Dim Nom_Du_Mois As String
    Dim i As Integer
    Dim Trouver_Colonne_Mois As Boolean
 
    Trouver_Colonne_Mois = False
 
    Sheets("MapResponsibility").Select
    'récupérer nom du mois
    Nom_Du_Mois = Range("C5").Value
 
 
 
    '========================================
    'trouver la bonne colonne selon le mois
    Sheets("AuditMensuel").Select
    For i = 2 To 13 ' les mois de la feuille Audit Mensuel
        If Cells(5, i) = Nom_Du_Mois Then
            Trouver_Colonne_Mois = True
            Exit For
        End If
    Next
    '========================================
 
    If Trouver_Colonne_Mois = True Then
        For j = 6 To 84 ' la colonne de la feuille d'audit mensuel
 
            If Cells(j, i).Value = "" Then
                For b = 2 To 50 'les colonnes de la feuille MapResponsibility
                    For bb = 8 To 38 'les lignes de la feuille MapResponsibility
                        If Worksheets("MapResponsibility").Cells(bb, b).Value = Cells(j, 1).Value Then Worksheets("MapResponsibility").Cells(bb, b).Interior.ColorIndex = 2
                    Next
                Next
            ElseIf Cells(j, i).Value <= 0.2 Then
                For r = 2 To 50
                    For rr = 8 To 38
                        If Worksheets("MapResponsibility").Cells(rr, r).Value = Cells(j, 1).Value Then Worksheets("MapResponsibility").Cells(rr, r).Interior.ColorIndex = 3
                    Next
                Next
             ElseIf Cells(j, i).Value > 0.2 And Cells(j, i).Value <= 0.4 Then
                For w = 2 To 50
                    For ww = 8 To 38
                        If Worksheets("MapResponsibility").Cells(ww, w).Value = Cells(j, 1).Value Then Worksheets("MapResponsibility").Cells(ww, w).Interior.ColorIndex = 44
                    Next
                Next
 
             ElseIf Cells(j, i).Value > 0.4 And Cells(j, i).Value <= 0.6 Then
                For y = 2 To 50
                    For yy = 8 To 38
                        If Worksheets("MapResponsibility").Cells(yy, y).Value = Cells(j, 1).Value Then Worksheets("MapResponsibility").Cells(yy, y).Interior.ColorIndex = 6
                    Next
                Next
            ElseIf Cells(j, i).Value > 0.6 And Cells(j, i).Value <= 0.8 Then
                For v = 2 To 50
                    For vv = 8 To 38
                        If Worksheets("MapResponsibility").Cells(vv, v).Value = Cells(j, 3).Value Then Worksheets("MapResponsibility").Cells(vv, v).Interior.ColorIndex = 28
                    Next
                Next
 
             ElseIf Cells(j, i).Value > 0.8 And Cells(j, i).Value <= 1 Then
                For v = 2 To 50
                    For vv = 8 To 38
                        If Worksheets("MapResponsibility").Cells(vv, v).Value = Cells(j, 3).Value Then Worksheets("MapResponsibility").Cells(vv, v).Interior.ColorIndex = 4
                    Next
                Next
            Else
                MsgBox Cells(j, i).Value & " ne rencontre pas les conditions"
            End If
 
        Next
    Else
        MsgBox "Aucun mois n'a été trouvé !"
    End If
  Sheets("MapResponsibility").Select
    MsgBox "Mise à jour réussie !"
 
End Sub

Merci d'avance :)

08/04/2015, 00h59
gnain

Citation:

Envoyé par rihab92

du coup l'exécution de la macro prend un certain retard,
donc j'aimerai bien optimiser le code si c possible pour le rendre efficace, je ne sais pas si c exactement à cause de plusieurs conditions , si je dois faire select case au liieu de if else if ..., si oui comment ?

tes boucles ne sont pas très grande
ce code devrait s'exécuter assez rapidement.

combien de temps il prend ?

pour gagner du temps il est toujours mieux de ne pas sélectionner les feuilles pour collecter des données.
il faut faire comme cela.

Code:

Nom_Du_Mois = Sheets("MapResponsibility").Range("C5").Value

mais dans ton cas cela n'aura pas beaucoup d'impact.

Si ton sub Colorier_MapResponsibility() est appeler par un évènement Worksheet_Change ou semblable
alors chaque fois qu'une couleur change votre sub Colorier_MapResponsibility() se rappelle.
dans ce cas alors oui cela peut être très long.

Si tu en est pas certain, il faut mettre un point d'arrêt sur la ligne 6, tu verras si le déroulement passe souvent
dans ce sub.

si non je ne voie pas.
08/04/2015, 01h34
rihab92

Merciii gnanin , maintenant ça a diminué un petit peu

temps = 7s
08/04/2015, 01h51
gnain

7 secondes, cela me parait très long pour ce code,
avez-vous vérifié si ce sub n'est pas appeler plusieurs fois.
08/04/2015, 09h15
Michel_M

Bonjour,

En début de macro écrire cette ligne

Code:

Application.Screenupdating=False

qui fige le défilement de l'écran et fait ganer beaucoup de temps!

nota
il n'est pas nécessaire de remettre à "False" à la fin de la macro

Bonjour

Tu devrais pouvoir gagner du temps avec un petit tableau et une variable variable définie une seule fois.

Code:

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
If Trouver_Colonne_Mois = True Then
 
        ggg = Worksheets("MapResponsibility").Range(Worksheets("MapResponsibility").Cells(1, 1), Worksheets("MapResponsibility").Cells(38, 50)).Value
 
        For j = 6 To 84 ' la colonne de la feuille d'audit mensuel
            gb = Sheets("AuditMensuel").Cells(j, 1).Value
            If Sheets("AuditMensuel").Cells(j, i).Value = "" Then
                For b = 2 To 50 'les colonnes de la feuille MapResponsibility
                    For bb = 8 To 38 'les lignes de la feuille MapResponsibility
                        If ggg(bb, b) = gb Then
                         Worksheets("MapResponsibility").Cells(bb, b).Interior.ColorIndex = 24
                        End If
                    Next
                Next
            ElseIf Cells(j, i).Value <= 0.2 Then

08/04/2015, 14h26
rihab92

Citation:

Envoyé par gnain

7 secondes, cela me parait très long pour ce code,
avez-vous vérifié si ce sub n'est pas appeler plusieurs fois.

Salut gnain, il n'est pas appelé plusieurs fois