Discussion :

[janigrel]

Bonjour,

J'ai un (très) grand tableau (plage A1 : DD2000...).
Je souhaiterais pouvoir colorer le fond de chaque ligne, à l'intérieur de mon tableau (A1 D2000) :
- en orange quand la valeur "OUI" est présente dans la ligne à colorer, dans la colonne F OU dans la colonne I, OU dans la colonne N...
- en rouge quand une des 3 valeurs "REFUS", "ANCIEN CLIENT", "SAF" est présente dans la ligne à colorer, dans la colonne E, OU dans la colonne H, OU dans la colonne M...
Je précise que la valeur "OUI" et les 3 autres ne peuvent se trouver sur la même ligne, donc pas de conflit.

Je vous remercie d'avance de votre aide.
Cdt.

[bboy-eazy]

Bonjour,

Il faut aller dans mise en forme conditionnelle. C'est le moyen le plus simple de faire ce que vous voulez faire

[horemheb]

Bonjour,
Si tu veux passer par VBA tu peux t'inspirer de l'application que j'ai écrite pour mettre en vert ou rouge les cellules d'un tableau selon qu'elles contiennent un 0 ou un 1

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
'boucle sur les lignes
For i = 2 To 6
    'boucle sur les colonnes
    For j = 2 To 4
        'test de la cellule
        Cells(i, j).Select
        If Cells(i, j).Value = 0 Then
            'affectation de la couleur verte
            Selection.Interior.Color = QBColor(10)
        Else
            'affectation de la couleur rouge
            Selection.Interior.Color = QBColor(12)
        End If
    Next
Next

tu peux aussi passer par une macro : tu démarres une macro, tu fais une manip puis tu récupères le code correspondant que tu inclus dans tes boucles et tes tests
Salutations

[janigrel]

Merci Horemheb,
Dans ton exemple, tout le tableau se colore d'une couleur, ce qui ne correspond pas à mon besoin.
Quelqu'un a t-il une solution?
Pour répondre à bboy-easy, je pense qu'une MFC serait trop compliquée à mettre en oeuvre, car je dois tester de nombreuses colonnes pour aller chercher les valeurs "OUI",...etc
Salutations.

[MarcelG]

Bonsoir,

Regarde cette discussion. J'y ai proposé un code.
A adapter.

MISE EN COULEUR SOUS CONDITION

[janigrel]

Hello,
Je débute en VBA, j'aimerais donc que quelqu'un écrive si possible le code adapté exactement à l'exemple que j'ai décrit...
Merci de votre compréhension.
Cdt.

[keygen08]

Bonsoir
pour l'execution, onglet devellopeur, macro, colorie, executer.

Code :

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

1
2
3
4
5
6
7
8
9
10
11
12
13
Option Compare Text
Sub colorie()
Application.ScreenUpdating = False
    For Each cell In Range("a1:a2000")
    If Cells(cell.Row, 6) = "OUI" Or Cells(cell.Row, 9) = "OUI" Or Cells(cell.Row, 14) = "OUI" Then Range("a" & cell.Row & ":dd" & cell.Row).Interior.ColorIndex = 40
'    If Cells(cell.Row, 5) = "REFUS" Or Cells(cell.Row, 8) = "ANCIEN CLIENT" Or Cells(cell.Row, 13) = "SAF" Then Range("a" & cell.Row & ":dd" & cell.Row).Interior.ColorIndex = 3
 
    If Cells(cell.Row, 5) = "REFUS" Or Cells(cell.Row, 5) = "ANCIEN CLIENT" Or Cells(cell.Row, 5) = "SAF" Then Range("a" & cell.Row & ":dd" & cell.Row).Interior.ColorIndex = 3
    If Cells(cell.Row, 8) = "REFUS" Or Cells(cell.Row, 8) = "ANCIEN CLIENT" Or Cells(cell.Row, 8) = "SAF" Then Range("a" & cell.Row & ":dd" & cell.Row).Interior.ColorIndex = 3
    If Cells(cell.Row, 13) = "REFUS" Or Cells(cell.Row, 13) = "ANCIEN CLIENT" Or Cells(cell.Row, 13) = "SAF" Then Range("a" & cell.Row & ":dd" & cell.Row).Interior.ColorIndex = 3
    Next cell
Application.ScreenUpdating = True
End Sub

ceci est néanmoins un forum d'entraide, ceci sous-entends normalement un minimum de travail de la part du demandeur.

[janigrel]

Un grand merci à toi, keygen08, c'est exactement la macro qu'il me fallait. J'ai bien noté le "minimum de travail" : je t'assure que je ne peux travailler plus en ce moment... je ne connaissais quasi pas Excel il y a 2 mois, je fais déjà des tableaux croisés dynamiques, des classeurs liés, et déjà mis au point, avec l'aide des internautes, une macro qui me permet, pour 11 chargés d'affaires différents, avec adresse différente, d'envoyer automatiquement un courrier à des prospects, pour qui j'ai justement inscrit la valeur "OUI" dans mon fameux tableau... : une case "OUI" par journée de prospection.

Merci encore!

Cdt.

J'ai placé la macro sur le code de ma feuille pour une exé en temps réel.
J'ai une autre difficulté à régler, que je n'avais pas précisée à l'origine ; je souhaiterais que la ligne se colore en vert, et annule les anciennes couleurs (rouge ou orange) quand la valeur "RDV" est présente dans la colonne P ou dans la colonne S (dans mon exemple, quand le RDV avec le prospect est obtenu, la ligne se colore en vert).
Merci d'avance.
Slt.

[bboy-eazy]

alors il faut rajouter dans le code de Keygen08:

Code :

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

1
2
3
If Cells(cell.Row, 19) = "RDV" Or Cells(cell.Row, 16) = "RDV" Then
Range("a" & cell.Row & ":dd" & cell.Row).Interior.ColorIndex = 4
End If

A placer en dernier et faire varier le chiffre du colorindex si besoin. (un chiffre représente une couleur, ici le 4 est le vert par exemple)

[janigrel]

Bonsoir à tous,

La macro s'exécute correctement. Cependant, savez-vous comment revenir à la dernière couleur de ligne quand on supprime une valeur qui lui a donné sa couleur?
Je m'explique:
- si par exemple je saisis par erreur une valeur "OUI", et que je la supprime, comment retrouver une ligne blanche?
- si après un RDV, la ligne est colorée en vert, et que le RDV n'a rien donné, je souhaite pouvoir supprimer la valeur "RDV" et que la ligne retrouve sa couleur orange.
Peut-être avec la fonction Else...?
En résumé, que la ligne retrouve sa couleur avant suppression de la dernière valeur.

Merci de vos conseils avisés.
Cordialement.

Voici ma macro :

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
Private Sub Worksheet_SelectionChange(ByVal Target As Range)
 
Application.ScreenUpdating = False
    For Each Cell In Range("a3:a2000")
 
    If Cells(Cell.Row, 44) = "REFUS CAT" Or Cells(Cell.Row, 44) = "CLIENT/PROSPECT INTERNE" Or Cells(Cell.Row, 44) = "SANS AUTO" _
    Or Cells(Cell.Row, 49) = "REFUS CAT" Or Cells(Cell.Row, 49) = "CLIENT/PROSPECT INTERNE" Or Cells(Cell.Row, 49) = "SANS AUTO" _
    Or Cells(Cell.Row, 54) = "REFUS CAT" Or Cells(Cell.Row, 54) = "CLIENT/PROSPECT INTERNE" Or Cells(Cell.Row, 54) = "SANS AUTO" _
    Or Cells(Cell.Row, 59) = "REFUS CAT" Or Cells(Cell.Row, 44) = "CLIENT/PROSPECT INTERNE" Or Cells(Cell.Row, 44) = "SANS AUTO" _
    Or Cells(Cell.Row, 64) = "REFUS CAT" Or Cells(Cell.Row, 64) = "CLIENT/PROSPECT INTERNE" Or Cells(Cell.Row, 64) = "SANS AUTO" _
    Or Cells(Cell.Row, 69) = "REFUS CAT" Or Cells(Cell.Row, 69) = "CLIENT/PROSPECT INTERNE" Or Cells(Cell.Row, 69) = "SANS AUTO" _
    Or Cells(Cell.Row, 74) = "REFUS CAT" Or Cells(Cell.Row, 74) = "CLIENT/PROSPECT INTERNE" Or Cells(Cell.Row, 74) = "SANS AUTO" _
    Or Cells(Cell.Row, 79) = "REFUS CAT" Or Cells(Cell.Row, 79) = "CLIENT/PROSPECT INTERNE" Or Cells(Cell.Row, 79) = "SANS AUTO" _
    Or Cells(Cell.Row, 84) = "REFUS CAT" Or Cells(Cell.Row, 84) = "CLIENT/PROSPECT INTERNE" Or Cells(Cell.Row, 84) = "SANS AUTO" _
    Or Cells(Cell.Row, 89) = "REFUS CAT" Or Cells(Cell.Row, 89) = "CLIENT/PROSPECT INTERNE" Or Cells(Cell.Row, 89) = "SANS AUTO" _
    Or Cells(Cell.Row, 94) = "REFUS CAT" Or Cells(Cell.Row, 94) = "CLIENT/PROSPECT INTERNE" Or Cells(Cell.Row, 94) = "SANS AUTO" _
    Or Cells(Cell.Row, 99) = "REFUS CAT" Or Cells(Cell.Row, 99) = "CLIENT/PROSPECT INTERNE" Or Cells(Cell.Row, 99) = "SANS AUTO" _
    Or Cells(Cell.Row, 104) = "REFUS CAT" Or Cells(Cell.Row, 104) = "CLIENT/PROSPECT INTERNE" Or Cells(Cell.Row, 104) = "SANS AUTO" _
    Then Range("a" & Cell.Row & ":dd" & Cell.Row).Interior.ColorIndex = 3
 
    If Cells(Cell.Row, 45) = "OUI" Or Cells(Cell.Row, 50) = "OUI" Or Cells(Cell.Row, 55) = "OUI" Or Cells(Cell.Row, 60) = "OUI" _
    Or Cells(Cell.Row, 65) = "OUI" Or Cells(Cell.Row, 70) = "OUI" Or Cells(Cell.Row, 75) = "OUI" Or Cells(Cell.Row, 80) = "OUI" _
    Or Cells(Cell.Row, 85) = "OUI" Or Cells(Cell.Row, 90) = "OUI" Or Cells(Cell.Row, 95) = "OUI" Or Cells(Cell.Row, 100) = "OUI" _
    Or Cells(Cell.Row, 105) = "OUI" Then Range("a" & Cell.Row & ":dd" & Cell.Row).Interior.ColorIndex = 40
 
    If Cells(Cell.Row, 48) = "RDV" Or Cells(Cell.Row, 53) = "RDV" Or Cells(Cell.Row, 58) = "RDV" Or Cells(Cell.Row, 63) = "RDV" _
    Or Cells(Cell.Row, 68) = "RDV" Or Cells(Cell.Row, 73) = "RDV" Or Cells(Cell.Row, 78) = "RDV" Or Cells(Cell.Row, 83) = "RDV" _
    Or Cells(Cell.Row, 88) = "RDV" Or Cells(Cell.Row, 93) = "RDV" Or Cells(Cell.Row, 98) = "RDV" Or Cells(Cell.Row, 103) = "RDV" _
    Or Cells(Cell.Row, 108) = "RDV" _
    Then Range("a" & Cell.Row & ":dd" & Cell.Row).Interior.ColorIndex = 4
 
    Next Cell
 
 
Application.ScreenUpdating = True
 
End Sub

[keygen08]

Bonjour

Le plus simple est de passer la ligne tester en couleur automatique en debut de macro et les différents if la recolorieront de la bonne couleur.
donc après for each

Code :

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

1
2
    For Each cell In Range("a1:a2000")
    Range("a" & cell.Row & ":dd" & cell.Row).Interior.ColorIndex = -4142

puis les différents if

Noter que les trois codes ci dessous vous permettent d'obtenir le meme resultat

Code :

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

1
2
3
4
5
6
7
 For c = 45 To 105 Step 5
    If c = 50 Then c = 55
        If Cells(r, c) = "OUI" Then
        Range("a" & r & ":dd" & r).Interior.ColorIndex = 40
        Exit For
        End If
 Next c

Code :

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

1
2
3
4
5
plage = Union(Cells(r, 45), Cells(r, 55), Cells(r, 60), Cells(r, 65), Cells(r, 70), Cells(r, 75), _
 Cells(r, 80), Cells(r, 85), Cells(r, 90), Cells(r, 50), Cells(r, 95), Cells(r, 100), Cells(r, 105))
 For Each cell In plage
 If cell.Value = "OUI" Then Range("a" & r & ":dd" & r).Interior.ColorIndex = 40
Next cell

Code :

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

1
2
3
4
 If Cells(r, 45) = "OUI" Or Cells(r, 50) = "OUI" Or Cells(r, 55) = "OUI" Or Cells(r, 60) = "OUI" _
 Or Cells(r, 65) = "OUI" Or Cells(r, 70) = "OUI" Or Cells(r, 75) = "OUI" Or Cells(r, 80) = "OUI" _
 Or Cells(r, 85) = "OUI" Or Cells(r, 90) = "OUI" Or Cells(r, 95) = "OUI" Or Cells(r, 100) = "OUI" _
 Or Cells(r, 105) = "OUI" Then Range("a" & r & ":dd" & r).Interior.ColorIndex = 40

je ne vous cache pas ma preference pour le premier, facillité de lecture et sorti de la bouche dés qu'une condition est vrai donc gain de temps.

Pour aller au bout de mon idée, celle ci pourrait remplacer votre code.

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
Private Sub Worksheet_SelectionChange(ByVal Target As Range)
Dim r As Integer, c As Integer
Dim ArrWd
 For Each cell In Range("a3:a2000")
 Range("a" & cell.Row & ":dd" & cell.Row).Interior.ColorIndex = -4142 'couleur automatique
 r = cell.Row
 ArrWd = Split("REFUS CAT, CLIENT/PROSPECT INTERNE, SANS AUTO", ", ")
    For i = 0 To UBound(ArrWd)
        For c = 44 To 104 Step 5
            If Cells(r, c) = ArrWd(i) Then
            Range("a" & r & ":dd" & r).Interior.ColorIndex = 3 'rouge
            Exit For
            End If
        Next c
    Next i
 
 For c = 45 To 105 Step 5
    If c = 50 Then c = 55 ' ne manque t-il pas la col 50 dans votre code.
        If Cells(r, c) = "OUI" Then
        Range("a" & r & ":dd" & r).Interior.ColorIndex = 40 'orange
        Exit For
        End If
 Next c
 
  For c = 48 To 108 Step 5
    If c = 50 Then c = 55
        If Cells(r, c) = "OUI" Then
        Range("a" & r & ":dd" & r).Interior.ColorIndex = 4 'vert
        Exit For
        End If
  Next c
 
 Next cell
 End Sub

je viens d'ailleurs de m'apercevoir de la grosse erreur qu'il y a dans les deux codes, le mien et le votre
on re-analyse toutes la feuille a chaque changement de cellule, c'est une ineptie et une perte de temps, il ne faut reinterpreter
que les couleurs de la ligne que l'on vient de mettre a jour donc passer l'evenement en

Code :

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

Private Sub Worksheet_Change(ByVal Target As Range)

supprimer For Each cell In Range("a3:a2000") et le Next cell.

voila, j'espere que je vous laisse de quoi vous faire les dents

[janigrel]

Bonjour,
Tout d'abord merci de votre investissement sur mon code...
En attendant votre réponse, j'avais introduit plusieurs ElseIf et un Else dans mon code (un peu long et surtout un peu lent...), pour que la couleur de la ligne corresponde à celle de la dernière valeur inscrite à chaque journée prospection. Pour que vous compreniez bien ma problématique, voici en PJ une image extraite de mon tableau :

Les 6 premières lignes montrent les 6 cas possibles dans le temps. La ligne doit prendre la couleur de la dernière valeur inscrite à la dernière journée de prospection.
Les 3 dernières lignes montrent que les couleurs restent inchangées tant qu'une nouvelle valeur ne vient pas annuler une précédente.

Je ne sais pas si votre nouveau code répond à cette problématique, car j'ai un problème avec : lorsque je supprime uniquement la ligne 4 de votre code "For Each Cell..." et la ligne 31 "Next Cell", j'ai un message d'erreur sur la ligne 5 "Range ("a" & Cell...)".
Par ailleurs, pourquoi avoir ajouté ", " dans le Split ligne 7?
Enfin, ne manque t-il pas la définition de c= cell.Column?
A vous lire. Cordialement.

[keygen08]

Bonjour
Ce code répond à tout les besoins, mais

: lorsque je supprime uniquement la ligne 4 de votre code "For Each Cell..." et la ligne 31 "Next Cell", j'ai un message d'erreur sur la ligne 5 "Range ("a" & Cell...)".

ben oui normal. le debut devrait ressembler a ça puisque l'on retire le for each, cell devient inconnu. noter que r = cell.row, devient r= target.row

Code :

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

1
2
3
4
5
Private Sub Worksheet_Change(ByVal Target As Range)
Dim r As Integer, c As Integer
Dim ArrWd
 r = target.Row
 Range("a" & r & ":dd" & r).Interior.ColorIndex = -4142 'couleur automatique

Par ailleurs, pourquoi avoir ajouté ", " dans le Split ligne 7?

On demande au split de couper après ... la virgule + espace, par defaut le split coupe après un espace auquel cas "sans auto" aurait été découper en deux valeurs, ce qui ne correspondait plus a la valeur "sans auto" recherché.

Enfin, ne manque t-il pas la définition de c= cell.Column?

et bien non, car si c represente effectivement une adresse de colonne, il n'est pas egal à cell.column mais à 45 puis 50 puis 55...d'où le for c = 45 to 105 step 5

enfin, si vous partez d'une feuille completement blanche, il faudra d'abords executer la macro avec for each cell.

[janigrel]

Quelle classe! Grâce à vos explications, j'apprends de nouveaux plans, et surtout la macro est plus simple et plus rapide...
Ca fonctionne, à part que la ligne ne prend pas forcément la couleur de la dernière valeur inscrite chronologiquement.
Comme vous l'avez vu dans l'image de mon tableau "cible" que j'ai joint, la couleur de la ligne doit pouvoir se changer en fonction de la valeur inscrite dans la dernière colonne renseignée...
Je vais réfléchir sur ce sujet en reprenant votre code et peut-être rajouter des ElseIf...
@+ et merci encore.

[keygen08]

Bonsoir,

il faut faire tourner les compteur de C a l'envers

Code :

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

for c = 105 to 50 step -5

ainsi on analyse la valeur des cellules de droite a gauche et peut etre changer l'ordre des mise en couleur
on part de blancs, on colore en vert si..., en rouge si..., en orange si... mais c'est peut etre en rouge si..., en orange si..., etc
donc par ex remonter les lignes 25 à 31 avant la lignes 17
j'ai former des sous groupes en fonction des couleurs, il faut changer l'ordre de ces sous groupes.


il y a également une ligne if c=50 then c=55 qui n'est peut etre pas necessaire.
je me suis appuyé sur votre code ou il n'y avait pas de colonne 50.

[janigrel]

Bonjour,
J'ai essayé d'inverser les compteurs de c, mais je n'arrive pas au résultat escompté. En effet :
- si les compteurs de c tournent à l'envers, toutes les lignes prennent logiquement la couleur du 1er groupe "For c = ...",
- si les compteurs tournent comme initialement de la gauche vers la droite, toutes les lignes prennent logiquement la couleur du dernier groupe "For c =...".
Comme expliqué dans mon précédent message, j'aimerais que la couleur de la ligne corresponde à la valeur inscrite le plus à droite dans les colonnes.
Ci-joint Excel de mon tableau "cible" pour mieux comprendre.
A vous lire.

[keygen08]

Avec l'exemple donné, on voit de quel couleur sont les lignes mais on ne sait pas de quelle couleur elles devrait etre.
ou bien est ce le contraire, j'y perds mon latin. Ou sont les erreurs ?

J'ai peut etre enfin compris ce qu'il faut obtenir a tester avec le code suivant

Code :

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

1
2
3
4
5
6
7
8
9
10
11
12
13
Private Sub Worksheet_Change(ByVal Target As Range)
Dim r As Integer, c As Integer
Dim ArrWd
 Range("a" & Target.Row & ":dd" & Target.Row).Interior.ColorIndex = -4142 'couleur automatique
 r = Target.Row
 c = Cells(r, 250).End(xlToLeft).Column
 ArrWd = Split("REFUS CAT, CLIENT/PROSPECT INTERNE, SANS AUTO", ", ")
    For i = 0 To UBound(ArrWd)
            If Cells(r, c) = ArrWd(i) Then Range("a" & r & ":dd" & r).Interior.ColorIndex = 3 'rouge
    Next i
        If Cells(r, c) = "OUI" Then Range("a" & r & ":dd" & r).Interior.ColorIndex = 40 'orange
        If Cells(r, c) = "RDV" Then Range("a" & r & ":dd" & r).Interior.ColorIndex = 4 'vert
 End Sub

[janigrel]

Bonjour,

Le tableau cible que j'ai fourni en exemple est en fait le tableau "objectif", avec les lignes colorées à la main comme elles devraient être.
DONC votre nouveau code est exactement ce qu'il fallait, ça fonctionne impeccablement ! !
Je vous remercie vivement pour votre aide.
J'espère arriver à votre niveau un jour...

Si vous souhaitez participer à ma 2ème discussion sur le site, toujours liée à ce fichier, je vous invite sur : http://www.developpez.net/forums/d14...v/#post7728528

Bien cordialement.

Re,
Un dernier petit détail : dans les début du code : "r = Target.Row Range("a" & r & ":dd" & r).Interior.ColorIndex = -4142", comment colorer automatiquement en blanc uniquement à partir de la ligne 3 (car j'ai des entêtes de colonnes sur 2 lignes qui doivent conserver leurs couleurs de remplissage).
Merci par avance.

[janigrel]

Avec l'exemple donné, on voit de quel couleur sont les lignes mais on ne sait pas de quelle couleur elles devrait etre.
ou bien est ce le contraire, j'y perds mon latin. Ou sont les erreurs ?

J'ai peut etre enfin compris ce qu'il faut obtenir a tester avec le code suivant

Code :

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

1
2
3
4
5
6
7
8
9
10
11
12
13
Private Sub Worksheet_Change(ByVal Target As Range)
Dim r As Integer, c As Integer
Dim ArrWd
 Range("a" & Target.Row & ":dd" & Target.Row).Interior.ColorIndex = -4142 'couleur automatique
 r = Target.Row
 c = Cells(r, 250).End(xlToLeft).Column
 ArrWd = Split("REFUS CAT, CLIENT/PROSPECT INTERNE, SANS AUTO", ", ")
    For i = 0 To UBound(ArrWd)
            If Cells(r, c) = ArrWd(i) Then Range("a" & r & ":dd" & r).Interior.ColorIndex = 3 'rouge
    Next i
        If Cells(r, c) = "OUI" Then Range("a" & r & ":dd" & r).Interior.ColorIndex = 40 'orange
        If Cells(r, c) = "RDV" Then Range("a" & r & ":dd" & r).Interior.ColorIndex = 4 'vert
 End Sub

Bonjour Kengen08,
Plus besoin d'aller sur ma 2ème discussion, j'ai résolu le problème de ma RechercheV en supprimant le "Application.Calculation = xlCalculationManual
'...Application.Calculation = xlCalculationAutomatic".

Outre le fait d'avoir besoin de votre aide pour ne colorer les lignes de mon tableau uniquement qu'à partir de la 3ème ligne, je vais avoir besoin de rajouter un groupe de couleur (bleu) à mes lignes : même principe que déjà décrit, mais ici pour des valeurs "non vides" (=n'importe quelles valeurs) présentes dans les colonnes 46, 51, 56 ... jusqu'à 106 (step de 5). J'ai essayé de modifier le code, mais en vain...
Merci de vos précieux conseils.
Cordialement.

[keygen08]

Bonjour,
Le option compare text en entete permet a VBA de reconnaitre les valeurs "oui et autres" même si elle sont saisie en minuscule.

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
Option Compare Text
 
Private Sub Worksheet_Change(ByVal Target As Range)
Dim r As Integer, c As Integer
Dim ArrWd
'pour commencer en ligne 3
If Target.Row >= 3 Then
 Range("a" & Target.Row & ":dd" & Target.Row).Interior.ColorIndex = -4142 'couleur automatique
 r = Target.Row
 c = Cells(r, 250).End(xlToLeft).Column
 ArrWd = Split("REFUS CAT, CLIENT/PROSPECT INTERNE, SANS AUTO", ", ")
    For i = 0 To UBound(ArrWd)
            If Cells(r, c) = ArrWd(i) Then
            Range("a" & r & ":dd" & r).Interior.ColorIndex = 3 'rouge
            Exit Sub
            End If
    Next i
        If Cells(r, c) = "OUI" Then
        Range("a" & r & ":dd" & r).Interior.ColorIndex = 40 'orange
        Exit Sub
        Else
            If Cells(r, c) = "RDV" Then
            Range("a" & r & ":dd" & r).Interior.ColorIndex = 4 'vert
            Exit Sub
            Else
'ayant passer les autres test, on verifie que la celule contient une valeur pour peindre en bleu
                If Cells(r, c) <> "" Then Range("a" & r & ":dd" & r).Interior.ColorIndex = 37 'bleu
                Exit Sub
                End If
        End If
End If
 End Sub