Simplifier mon code

Version imprimable

Simplifier mon code

Bonjour à tous,

J'ai déjà réussi un code grâce à votre aide et mes petites connaissance.
J'aurais voulu savoir s'il était possible de le simplifier ?

Voici le code :

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
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
 
Set ws11 = Sheets("Controle")
Set plage11 = ws11.Range("A4:A39")
 
    With ws11
'Changement couleur ligne suivant place
        For Plage = 4 To 39
            If ws11.Range("A" & Plage) = "" Then
                ws11.Range("A" & Plage).Font.Color = RGB(0, 0, 0)
                ws11.Range("A" & Plage).Interior.Color = RGB(255, 255, 255)
                ws11.Range("B" & Plage).Font.Color = RGB(0, 0, 0)
                ws11.Range("B" & Plage).Interior.Color = RGB(255, 255, 255)
                ws11.Range("C" & Plage).Font.Color = RGB(0, 0, 0)
                ws11.Range("C" & Plage).Interior.Color = RGB(255, 255, 255)
                ws11.Range("D" & Plage).Font.Color = RGB(0, 0, 0)
                ws11.Range("D" & Plage).Interior.Color = RGB(255, 255, 255)
            ElseIf ws11.Range("D" & Plage) < 0 Then
                ws11.Range("A" & Plage).Font.Color = RGB(153, 0, 204)
                ws11.Range("A" & Plage).Interior.Color = RGB(255, 153, 255)
                ws11.Range("B" & Plage).Font.Color = RGB(153, 0, 204)
                ws11.Range("B" & Plage).Interior.Color = RGB(255, 153, 255)
                ws11.Range("C" & Plage).Font.Color = RGB(153, 0, 204)
                ws11.Range("C" & Plage).Interior.Color = RGB(255, 153, 255)
                ws11.Range("D" & Plage).Font.Color = RGB(153, 0, 204)
                ws11.Range("D" & Plage).Interior.Color = RGB(255, 153, 255)
            ElseIf ws11.Range("D" & Plage) = 0 Or ws11.Range("D" & Plage) = "" Then
                ws11.Range("A" & Plage).Font.Color = RGB(156, 0, 6)
                ws11.Range("A" & Plage).Interior.Color = RGB(255, 199, 206)
                ws11.Range("B" & Plage).Font.Color = RGB(0, 0, 0)
                ws11.Range("B" & Plage).Interior.Color = RGB(255, 255, 255)
                ws11.Range("C" & Plage).Font.Color = RGB(0, 0, 0)
                ws11.Range("C" & Plage).Interior.Color = RGB(255, 255, 255)
                ws11.Range("D" & Plage).Font.Color = RGB(0, 0, 0)
                ws11.Range("D" & Plage).Interior.Color = RGB(255, 255, 255)
            Else
                ws11.Range("A" & Plage).Font.Color = RGB(0, 97, 0)
                ws11.Range("A" & Plage).Interior.Color = RGB(198, 239, 206)
                ws11.Range("B" & Plage).Font.Color = RGB(0, 0, 0)
                ws11.Range("B" & Plage).Interior.Color = RGB(255, 255, 255)
                ws11.Range("C" & Plage).Font.Color = RGB(0, 0, 0)
                ws11.Range("C" & Plage).Interior.Color = RGB(255, 255, 255)
                ws11.Range("D" & Plage).Font.Color = RGB(0, 0, 0)
                ws11.Range("D" & Plage).Interior.Color = RGB(255, 255, 255)
            End If
        Next Plage
 
 
'Changement couleur ligne suivant age et apte
        For Plage = 4 To 27
            If ws11.Range("G" & Plage) = "" Then
                ws11.Range("G" & Plage).Font.Color = RGB(0, 0, 0)
                ws11.Range("G" & Plage).Interior.Color = RGB(255, 255, 255)
            ElseIf ws11.Range("G" & Plage) <= 17 Then
                ws11.Range("G" & Plage).Font.Color = RGB(156, 0, 6)
                ws11.Range("G" & Plage).Interior.Color = RGB(255, 199, 206)
            Else
                ws11.Range("G" & Plage).Font.Color = RGB(0, 97, 0)
                ws11.Range("G" & Plage).Interior.Color = RGB(198, 239, 206)
            End If
 
            If ws11.Range("F" & Plage) = "" Then
                ws11.Range("H" & Plage).Font.Color = RGB(0, 0, 0)
                ws11.Range("H" & Plage).Interior.Color = RGB(255, 255, 255)
            ElseIf ws11.Range("H" & Plage) = "" Then
                ws11.Range("H" & Plage).Font.Color = RGB(156, 0, 6)
                ws11.Range("H" & Plage).Interior.Color = RGB(255, 199, 206)
            Else
                ws11.Range("H" & Plage).Font.Color = RGB(0, 97, 0)
                ws11.Range("H" & Plage).Interior.Color = RGB(198, 239, 206)
            End If
 
 
'affichage doublon résultat négatif
        matchRow = Application.Match(ws11.Range("J" & Plage).Value, plage11, 0)
        isFound = Not IsError(matchRow)
            If isFound Then
                isValuePositive = ws11.Range("D" & plage11.Cells(matchRow, 1).Row).Value >= 0
                isValueRien = ws11.Range("D" & plage11.Cells(matchRow, 1).Row).Value <> ""
            Else
                isValuePositive = False
                isValueRien = False
            End If
 
            If (isFound And isValuePositive And isValueRien) Or ws11.Range("J" & Plage) = "" Then
                ws11.Range("J" & Plage).Font.Color = RGB(0, 0, 0)
                ws11.Range("J" & Plage).Interior.Color = RGB(255, 255, 255)
            Else
                ws11.Range("J" & Plage).Font.Color = RGB(153, 0, 204)
                ws11.Range("J" & Plage).Interior.Color = RGB(255, 153, 255)
            End If
        Next Plage
 
 
        If ws11.Range("D3") < 0 Then
            ws11.Range("D2", "D3").Font.Color = RGB(153, 0, 204)
            ws11.Range("D2", "D3").Interior.Color = RGB(255, 153, 255)
        Else
            ws11.Range("D2", "D3").Font.Color = RGB(0, 0, 0)
            ws11.Range("D2", "D3").Interior.Color = RGB(255, 255, 255)
        End If
    End With

Merci

Bonjour Maxou 10

Peut-être un peu mais pas beaucoup, une idée par exemple est d'utiliser Resize quand c'est possible

Code:

1
2
3
4
            If ws11.Range("A" & plage) = "" Then
                ws11.Range("A" & plage).Resize(1, 4).Font.Color = RGB(0, 0, 0)
                ws11.Range("A" & plage).Resize(1, 4).Interior.Color = RGB(255, 255, 255)
            ElseIf ws11.Range("D" & plage) < 0 Then

A+

Salut, teste ceci, j'ai simplifié avec la structure Select Case, c'est plus lisible et facile à maintenir. J'ai affecté les couleurs aux variables fontColor et interiorColor, cela évite la répétition des codes rgb et c'est plus lisible.

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
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
Sub Test()
    Dim ws11 As Worksheet
    Dim plage11 As Range
    Dim Plage As Long
    Dim matchRow As Variant
    Dim isFound As Boolean, isValuePositive As Boolean, isValueRien As Boolean
 
    Set ws11 = Sheets("Controle")
    Set plage11 = ws11.Range("A4:A39")
 
    With ws11
        ' Changement couleur ligne suivant place
        For Plage = 4 To 39
            Dim cellD As Range
            Set cellD = .Range("D" & Plage)
 
            Dim fontColor As Long, interiorColor As Long
 
            Select Case True
                Case .Range("A" & Plage).Value = ""
                    fontColor = RGB(0, 0, 0)
                    interiorColor = RGB(255, 255, 255)
                Case cellD.Value < 0
                    fontColor = RGB(153, 0, 204)
                    interiorColor = RGB(255, 153, 255)
                Case cellD.Value = 0 Or cellD.Value = ""
                    fontColor = RGB(156, 0, 6)
                    interiorColor = RGB(255, 199, 206)
                Case Else
                    fontColor = RGB(0, 97, 0)
                    interiorColor = RGB(198, 239, 206)
            End Select
 
            ' Appliquer les couleurs sur les colonnes A à D
            .Range("A" & Plage & ":D" & Plage).Font.Color = fontColor
            .Range("A" & Plage).Interior.Color = interiorColor
            .Range("B" & Plage & ":D" & Plage).Interior.Color = RGB(255, 255, 255)
        Next Plage
 
        ' Changement couleur ligne suivant âge et apte
        For Plage = 4 To 27
            ' Colonne G (âge)
            Dim cellG As Range
            Set cellG = .Range("G" & Plage)
 
            Select Case True
                Case cellG.Value = ""
                    fontColor = RGB(0, 0, 0)
                    interiorColor = RGB(255, 255, 255)
                Case cellG.Value <= 17
                    fontColor = RGB(156, 0, 6)
                    interiorColor = RGB(255, 199, 206)
                Case Else
                    fontColor = RGB(0, 97, 0)
                    interiorColor = RGB(198, 239, 206)
            End Select
            cellG.Font.Color = fontColor
            cellG.Interior.Color = interiorColor
 
            ' Colonne H (apte)
            Dim cellH As Range
            Set cellH = .Range("H" & Plage)
 
            Select Case True
                Case .Range("F" & Plage).Value = "" Or cellH.Value = ""
                    fontColor = RGB(156, 0, 6)
                    interiorColor = RGB(255, 199, 206)
                Case Else
                    fontColor = RGB(0, 97, 0)
                    interiorColor = RGB(198, 239, 206)
            End Select
            cellH.Font.Color = fontColor
            cellH.Interior.Color = interiorColor
        Next Plage
 
        ' Affichage doublon résultat négatif
        For Plage = 4 To 39
            matchRow = Application.Match(.Range("J" & Plage).Value, plage11, 0)
            isFound = Not IsError(matchRow)
 
            If isFound Then
                isValuePositive = .Range("D" & plage11.Cells(matchRow, 1).Row).Value >= 0
                isValueRien = .Range("D" & plage11.Cells(matchRow, 1).Row).Value <> ""
            Else
                isValuePositive = False
                isValueRien = False
            End If
 
            If (isFound And isValuePositive And isValueRien) Or .Range("J" & Plage).Value = "" Then
                fontColor = RGB(0, 0, 0)
                interiorColor = RGB(255, 255, 255)
            Else
                fontColor = RGB(153, 0, 204)
                interiorColor = RGB(255, 153, 255)
            End If
 
            .Range("J" & Plage).Font.Color = fontColor
            .Range("J" & Plage).Interior.Color = interiorColor
        Next Plage
 
        ' Vérification des cellules D2 et D3
        Dim cellD2D3 As Range
        Set cellD2D3 = .Range("D2:D3")
 
        If .Range("D3").Value < 0 Then
            fontColor = RGB(153, 0, 204)
            interiorColor = RGB(255, 153, 255)
        Else
            fontColor = RGB(0, 0, 0)
            interiorColor = RGB(255, 255, 255)
        End If
 
        cellD2D3.Font.Color = fontColor
        cellD2D3.Interior.Color = interiorColor
    End With
End Sub

23/01/2025, 09h12
Maxou 10

Impeccable, Cela fonctionne !
Merci.

Si je doit appliquer ce code sur plusieurs feuille est possible de simplifier ?
J'ai fait :

with ws11
code
End with

with ws12
code
End with

with ws12
code
End with

Merci à vous

Bonjour,
Un exemple parmi d'autres

Code:

1
2
3
4
5
6
7
8
9
10
Sub t()
  Dim ws11 As Worksheet
  Dim t As Variant
  Dim s As Integer
  t = Array("Feuil1", "Feuil3", "Feuil")
  For s = 0 To UBound(t)
    Set ws11 = ThisWorkbook.Worksheets(t(s))
  Next
  Set ws11 = Nothing
End Sub