Discussion :

[NEC14]

Bonjour à tous,

Je cherche à colorer une cellule selon 5 conditions. J'avais commencé avec MFC sous Excel mais cela ne va pas au-delà de 3 conditions, donc je suis obligé de passer par du code VBA.

1° - Si la cellule I5 est vide alors la cellule G5 n'a pas de couleur.
2° - Si la date de la cellule I5 est inférieure à celle en A1 alors la cellule G5 est verte.
3° - Si la date de la cellule I5 est inférieure de 15 jours à celle en A1 alors la cellule G5 est orange. Elle reste orange jusqu'à ce que A1=I5
4° - Si la date de la cellule A1 est supérieure à I5 alors G5 est rouge.
5° - Si dans la cellule G4 il y a un "X" alors G5 est jaune.

Cette macro doit se répéter, pour les 4 premières conditions, pour chaque cellule de la colonne I.

La 5ème condition concerne les cellules de la ligne 4 (G;J;M;P;S;V;Y;AB;AE;AH;AK;AN;AQ;AT;AW)

Pouvez-vous m'aider s'il vous plait ? Merci par avance

J'ai commencé à faire ceci mais ça ne fonctionne pas.

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
 
Private Sub Worksheet_SelectionChange(ByVal Target As Range)
    Range("G5").Select
    If Cells("I5").Value = "" Then
    Selection.Interior.ColorIndex = 2
    If Cells("I5").Value < Cells.Value("A1") Then
    Selection.Interior.ColorIndex = 4
    If Cells("I5").Value > Cells.Value("A1") Then
    Selection.Interior.ColorIndex = 3
    If Cells("G4").Value = "X" Then
    Selection.Interior.ColorIndex = 6
    End If
    End If
    End If
    End If
End Sub

[Daniel.C]

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
Bonjour,
 
Je ne suis pas limité à la ligne 5, je ne sais pas si j'ai bien fait :
 
Private Sub Worksheet_Change(ByVal Target As Range)
    If Target.Column = 7 Or Target.Column = 9 Or Target.Address = "$A$1" Then
        If Cells(Target.Row, 9) = "" Then
            Cells(Target.Row, 7).Interior.ColorIndex = xlNone
        ElseIf IsDate(Cells(Target.Row, 9)) And Cells(Target.Row, 9) < [A1] Then
            Cells(Target.Row, 7).Interior.ColorIndex = 4
        ElseIf [A1] - Cells(Target.Row, 9) >= 15 Then
            Cells(Target.Row, 7).Interior.ColorIndex = 46
        ElseIf [A1] < Cells(Target.Row, 9) Then
            Cells(Target.Row, 7).Interior.ColorIndex = 3
        End If
    End If
    Intersect(Rows(4), Range("G:G,J:J,M:M,P:P,S:S,V:V,Y:Y,AB:AB,AE:AE,AH:AH,AK:AK,AN:AN,AQ:AQ,AT:AT,AW:AW")).Select
    If Not Intersect(Rows(4), Range("G:G,J:J,M:M,P:P,S:S,V:V,Y:Y,AB:AB,AE:AE,AH:AH,AK:AK,AN:AN,AQ:AQ,AT:AT,AW:AW")) Is Nothing Then
        Cells(Target.Row, 7).Interior.ColorIndex = 6
    End If
End Sub

[NEC14]

Merci Daniel,

Merci pour ton aide.
En effet, la macro doit concernée toutes les cellules de la colonne 9 (I).

J'ai mis ton code en application mais cela ne fonctionne pas correctement. En effet, dès l'instant où une date est supérieure à celle en A1, la cellule en G ne passe pas en rouge et l'orange ne passe pas non plus. La cellule reste au vert quoi qu'il arrive.

Par contre, j'ai supprimé la partie concernant le X, car je dois procéder autrement. Désolé de t'avoir fais travaillé pour rien.

Donc le code actuel est comme suit :

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
11
12
13
14
 
Private Sub Worksheet_Change(ByVal Target As Range)
    If Target.Column = 7 Or Target.Column = 9 Or Target.Address = "$A$1" Then
        If Cells(Target.Row, 9) = "" Then
            Cells(Target.Row, 7).Interior.ColorIndex = xlNone
        ElseIf IsDate(Cells(Target.Row, 9)) And Cells(Target.Row, 9) < [A1] Then
            Cells(Target.Row, 7).Interior.ColorIndex = 4
        ElseIf [A1] - Cells(Target.Row, 9) >= 15 Then
            Cells(Target.Row, 7).Interior.ColorIndex = 46
        ElseIf [A1] < Cells(Target.Row, 9) Then
            Cells(Target.Row, 7).Interior.ColorIndex = 3
        End If
    End If
End Sub

[Daniel.C]

Tu avais écrit :

4° - Si la date de la cellule A1 est supérieure à I5 alors G5 est rouge.

J'ai mis "inférieure" au lieu de "supérieur", sinon, ça fait double-emploi avec 2°

Essaie comme ça (pas eu le temps de tester) :

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
Private Sub Worksheet_Change(ByVal Target As Range)
    If Target.Column = 7 Or Target.Column = 9 Or Target.Address = "$A$1" Then
        If Cells(Target.Row, 9) = "" Then
            Cells(Target.Row, 7).Interior.ColorIndex = xlNone
        End If
        If IsDate(Cells(Target.Row, 9)) And Cells(Target.Row, 9) < [A1] Then
            Cells(Target.Row, 7).Interior.ColorIndex = 4
        End If
        If [A1] - Cells(Target.Row, 9) >= 15 Then
            Cells(Target.Row, 7).Interior.ColorIndex = 46
        End If
        If [A1] < Cells(Target.Row, 9) Then
            Cells(Target.Row, 7).Interior.ColorIndex = 3
        End If
    End If
End Sub

[NEC14]

Désolé mais rien ne se passe, la cellule reste sans couleur.

Je vais expliquer comment fonctionne mon tableau.

Donc en A1 = Aujourdhui().
A partir de I4, il ya cette formule dans chaque cellule de la colonne I

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
 
=SI(H4="";"";MOIS.DECALER(H4;$G$2))

Je n'interviens donc en saisie que sur les cellules de la colonne H, où je saisie une date.

Par exemple : En H4, j'ai saisi 15-03-2013. En G2, il y a 3. Donc la date de I4 sera H4 + 3 mois soit le 15-06-2013.

A partir de là, je mets une sorte d'avertisseur en place selon les conditions émises dans mes précédents messages. G4 vert si H4 inférieur à A1, Orange si A1 arrive à 15 jours de H4 et Rouge si H4 est supérieure à A1.

Merci beaucoup pour ton aide et ta patience.

[Daniel.C]

On ne peut pas utiliser "Worksheet_Change" si les valeurs sont le résultat de formules :

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
Private Sub Worksheet_Calculate()
    For Each c In Range([A4], Cells(Rows.Count, 1).End(xlUp))
        If Cells(c.Row, 9) = "" Then
            Cells(c.Row, 7).Interior.ColorIndex = xlNone
        Else
            If IsDate(Cells(c.Row, 9)) And Cells(c.Row, 9) < [A1] Then
                Cells(c.Row, 7).Interior.ColorIndex = 4
            End If
            If [A1] - Cells(c.Row, 9) <= 15 Then
                Cells(c.Row, 7).Interior.ColorIndex = 46
            End If
            If [A1] < Cells(c.Row, 9) Then
                Cells(c.Row, 7).Interior.ColorIndex = 3
            End If
        End If
    Next c
End Sub

[NEC14]

Merci Daniel, pour le moment ça fonctionne plutôt bien, sauf si la date en A1 est égale à celle en I où rien ne se passe.

Mais je vais chercher un peu.

Encore mille mercis

Bonjour à tous, Bonjour Daniel,

ça fonctionne bien dans tous les cas de figure. Maintenant j'aurai une autre question toujours sur le même sujet.

Ce code fonctionne pour les 2 premières colonnes, il faut que je l'applique à l'ensemble de mon tableau, c'est-à-dire jusqu'à la colonne 51.

Est-ce que je peux écrire le code de cette façon ?

Merci par avance

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
 
Private Sub Worksheet_Calculate()
    For Each c In Range([A4], Cells(Rows.Count, 1).End(xlUp))
        If Cells(c.Row, 9,12,15,18,21) = "" Then
            Cells(c.Row, 7,10,13,16,19).Interior.ColorIndex = xlNone
etc...
        End Sub

je viens d'essayer cela ne fonctionne pas. Je vais chercher encore, mais si vous avez une idée, merci par avance.

[Daniel.C]

Bonjour,

Il faut que tu modifies la macro ci-dessous pour ajouter le cas où les dates sont égales (je ne l'ai pas trouvé dans ton premier message) :

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
Private Sub Worksheet_Calculate()
    For Each c In Range([A4], Cells(Rows.Count, 1).End(xlUp))
        For i = 7 To 49 Step 3
            If Cells(c.Row, i + 2) = "" Then
                Cells(c.Row, i).Interior.ColorIndex = xlNone
            Else
                If IsDate(Cells(c.Row, i + 2)) And Cells(c.Row, i + 2) > [A1] Then
                    Cells(c.Row, 7).Interior.ColorIndex = 4
                End If
                If Cells(c.Row, i + i) > [A1] Then
                    If Cells(c.Row, i + 2) - [A1] <= 15 Then
                        Cells(c.Row, i).Interior.ColorIndex = 46
                    End If
                End If
                If [A1] > Cells(c.Row, i + 2) Then
                    Cells(c.Row, i).Interior.ColorIndex = 3
                End If
            End If
        Next i
    Next c
End Sub

[NEC14]

Merci Daniel, cela fonctionne bien.

Est-ce que tu peux m'expliquer ton code car je vais peut-être insérer une colonne avant celle qui est colorée, de cette façon je pourrais apporter les modifications nécessaires.

Je t'en remercie par avance
Cordialement
René

[Daniel.C]

N'hésite pas à demander des précisions si tu l'estimes nécessaire :

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
'la macro se déclenche à chaque recalcul
Private Sub Worksheet_Calculate()
    'boucle sur chaque cellule remplie de la colonne A
    For Each C In Range([A4], Cells(Rows.Count, 1).End(xlUp))
        'boucle de la colonne 7 à la colonne 49 toutes les 3 colonnes
        For i = 7 To 49 Step 3
            'si la cellule de la colonne I (ou L, ou O...) est vide
            If Cells(C.Row, i + 2) = "" Then
                'la cellule de la colonne G(ou J, ou M...) est sans couleur
                Cells(C.Row, i).Interior.ColorIndex = xlNone
            'sinon
            Else
                'si cette cellule est une date et qu"elle est plus grande que A1
                If IsDate(Cells(C.Row, i + 2)) And Cells(C.Row, i + 2) > [A1] Then
                    'couleur verte
                    Cells(C.Row, 7).Interior.ColorIndex = 4
                End If
                'si cette cellule est plus granfe que A1
                If Cells(C.Row, i + i) > [A1] Then
                    '... et que l'écart est de quize jours ou moins
                    If Cells(C.Row, i + 2) - [A1] <= 15 Then
                        'couleur orange
                        Cells(C.Row, i).Interior.ColorIndex = 46
                    End If
                End If
                'si cette cellule est inférieure à A1
                If [A1] > Cells(C.Row, i + 2) Then
                    'couleur rouge
                    Cells(C.Row, i).Interior.ColorIndex = 3
                End If
            End If
        Next i
    Next C
End Sub

[NEC14]

Merci beaucoup Daniel, je vais pouvoir me débrouiller seul (au moins essayer).

Bonne fin de journée.

Bien amicalement

René