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 vba : 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
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