Couleur cellule celon valeur

F

Fabrice Carlton

Guest
Bonjour,
J'ai un tableau a réaliser ou il y a des valeurs.
C'est un tableau de suivit du diabetes.
Il me faut donc des indicateurs de couleur (couleur de fond de cellule) pour voir quand les taux etaient élevés,moyen,bas etc...

Je dois faire 6 différentes couleurs:
- Pas de couleur si cellule vide
- Vert clair si valeur <= 1
- Vert si 1 < valeur <=1.20
- Jaune clair si 1.20 < valeur <=1.30
- Brun si 1.30 < valeur <=1.50
- Orange clair si valeur < 1.50

J'ai essayer avec l'outils:
Format > Mise en forme conditionnelle...

Mais il n'est possible d'ajouter que 3 conditions
Alors si vous voyez un moyen?

J'ai essayer avec:
=SI(A1<=1;VRAI;FAUX)
Mais a la place de VRAI et FAUX j'ai chercher la formule qui commenderait le changement de couleur de fond mais je ne vois pas.

Merci d'avance
Amicalement Fabrice
 
R

René du var

Guest
Bonsoir le forum,

Voici un solution que tu dois adapter à ton prblème




METTRE DANS LA FEUILLE CONCERNER
Private Sub Worksheet_Change(ByVal Target As Range)
Call MFC_Colorie_Cellules(Target)
End Sub


METTRE DANS UN MODULE
Sub MFC_Colorie_Cellules(Target)

Dim c As Range
For Each c In ActiveSheet.Range("A1:J200")
If c = "" Then
c.Interior.ColorIndex = 0
ElseIf c >= 1 And c < 11 Then
c.Interior.ColorIndex = 8
ElseIf c > 10 And c < 21 Then
c.Interior.ColorIndex = 23
ElseIf c > 20 And c < 31 Then
c.Interior.ColorIndex = 36
ElseIf c > 30 And c < 41 Then
c.Interior.ColorIndex = 37
ElseIf c > 40 And c < 51 Then
c.Interior.ColorIndex = 36
ElseIf c > 50 And c < 61 Then
c.Interior.ColorIndex = 38
ElseIf c > 60 And c < 71 Then
c.Interior.ColorIndex = 39
ElseIf c > 70 And c < 81 Then
c.Interior.ColorIndex = 45
ElseIf c > 80 And c < 91 Then
c.Interior.ColorIndex = 40
ElseIf c > 90 And c < 101 Then
c.Interior.ColorIndex = 41
ElseIf c > 100 And c < 111 Then
c.Interior.ColorIndex = 42
End If
Next
End Sub

René du var
 
F

Fabrice Carlton

Guest
Je n'arrive pas a faie marcher ton code.
Les cases deviennet en partie bleu fluo.

Je laisse le fichier en piece jointe
Si un reammenagement vous arrange pas de probleme
C'est l'onglet "matin"

Merci René
Amicalement Fabrice
 

Fichiers joints

B

Bernard

Guest
Bonsoir Fabrice, René du var et Michel_M

Une autre approche mais qui est équivalente à celle de Michel_M.

Cordialement

Bernard
 

Fichiers joints

C

CHti160

Guest
Salut"Fabrice Carlton","René du var ","Michel_M "
re le"FORUM"
une pièce jointe avec le cas supérieur à 1,50
à adapter
A+++
Jean Marie
 

Fichiers joints

M

myDearFriend

Guest
Bonsoir tout le monde, le Forum.


Fabrice, ayant trouvé le sujet très intéressant, je me suis amusé à bricoler ton exemple, et me joins également à la fête...

Outre le fait qu'il convenait de permettre l'application de mises en forme conditionnelles non limitées à 3 options, je suis parti du principe qu'il serait intéressant de permettre la gestion du format "global" des cellules (police, bordures, couleurs de fond et d'écriture) et laisser l'utilisateur décider de ces formats et des valeurs associées de façon simple et sans avoir à modifier le code VBA.

J'ai donc rajouté un onglet "Prefs" dans lequel l'utilisateur peut modifier la liste des formats disponibles ou en rajouter à sa guise.

Pour gérer les cellules cibles, le code utilisé est le suivant :
Private Sub Workbook_SheetChange(ByVal Sh As Object, ByVal Target As Range)
Dim TabTemp As Variant
Dim L As Long
'Ne gère pas les sélections de plages
If Target.Cells.Count > 1 Then Exit Sub
'Vérifie la présence du format conditionnel "spécial"
If Target.FormatConditions.Count < 1 Then Exit Sub
If Target.FormatConditions(1).Formula1 = "=mDF" Then
With Sheets("Prefs")
'Charge les préférences dans un tableau variant temporaire
L = .Range("A65536").End(xlUp).Row
TabTemp = .Range(.Cells(1, 1), .Cells(L, 1)).Value
'Détermine le format à utiliser suivant la valeur de la cellule
If Target.Value = "" Then
L = 1
Else
For L = 2 To UBound(TabTemp, 1)
If Target.Value < TabTemp(L, 1) Then Exit For
Next L
End If
Application.EnableEvents = False
'Applique le format
.Cells(L, 2).Copy
Target.PasteSpecial Paste:=xlPasteFormats, Operation:=xlNone, _
SkipBlanks:=False, Transpose:=False
Target.FormatConditions.Add Type:=xlExpression, Formula1:="=mDF"
Application.CutCopyMode = False
Application.EnableEvents = True
End With
End If
End Sub


Pour sélectionner les cellules "cibles", il suffit simplement de leur appliquer une mise en forme conditionnelle comme suit :
1/ Sélectionner la ou les cellule(s)
2/ Faire "Mise en forme conditionnelle..."
3/ Choisir dans la liste : "La formule est"
4/ Saisir "=mDF"
5/ Puis valider par "OK".



Cordialement,
Didier_mDF
 

Fichiers joints

C

CHti160

Guest
Salut "à tous"
bonjour le "FORUM"
Qu'il est beau d'avoir des idées et de savoir les concrétiser
merci à toi "myDearFriend" pour cette réalisation qui va en interresser plus d'un
Bon Dimanche à tous
A+++
Jean Marie
 
C

Celeda

Guest
Bonjour,

ohl lahla lahalahhhaa!!!!

ah que vi Jean-Marie, tu as raison

"qui va en interresser plus d'unE!!!"


Celeda
 
P

Pat5

Guest
Bonjour tout le monde

Très intéressant myDearFriend. Merçi.

Salut Celeda.

Bon dimanche à tous. Soleil magnifique et bloqué maison, sniff.

Pat5 ;o)
 
C

CHti160

Guest
Salut "les Filles"
re le"FORUM"
OUI j'ai OUBLIE "pour vous de vous" inclure dans les Intéressés
mais bon sur ce "FORUM" moi je suis pour l'égalité et je vous inclus d'office dans mes remerciements, mes remarques, possitives comme négatives
donc pas de problème car vous ("Les Filles du FORUM") vous nous êtes INDISPENSABLES donc excuces
A+++
Jean Marie
 
C

Chris

Guest
Bonjour
Super le code de My Dear Friend. Cela m'a inspiré.
Du coup j'ai commencé à y mettre mon grain de sel : pour gérer une plage et non une seule cellule (j'aime bien saisir plusieurs valeurs en même temps).
Je regardes aussi pour que les prefs puissent gérer non seulement des plages de valeurs mais aussi des égalités, des différences...
Pour en faire un truc un peu plus universel.
J'ai pas encore fini et comme la semaine va être chagée, je repasserai sur le fil dans quelques jours.

Comme quoi ça intéresse effectivement plus d'unE !!!

Chris
 
C

CHti160

Guest
Salut "Chris "
Oui prends ton temps, sur le "FORUM" on est pas préssé et on aime les choses bien pensées et bien faites comme vous savez les faire
donc vas y !!!! ,:eek:)
et on va repasser sur ce fil, (Lol ) t'inquies ;0)
A+++
Jean Marie
 
M

myDearFriend

Guest
Tout à fait Chris,


Pour ma part, j'avais également en tête d'en faire une XLA...


Cordialement,
Didier_mDF
 
J

jean

Guest
Bonjour à tous,

J'ai essayé de me servir du code de mDF, mais sans succés.

Pourriez vous svp jeter un oeil à mon fichier et me dire ce que j'ai oublié de faire.

Merci d'avance.

Cordialement.

Jean
 

Fichiers joints

M

myDearFriend

Guest
re- Jean,

Dans ton exemple, pour que ça fonctionne, il faut modifier une toute petite partie du code seulement :

For L = 2 To UBound(TabTemp, 1)
If Target.Value
< TabTemp(L, 1) Then Exit For
Next L

A modifier en :
For L = 2 To UBound(TabTemp, 1)
If Target.Value
= TabTemp(L, 1) Then Exit For
Next L


En remplaçant "<" par "=", ça devrait être suffisant pour faire fonctionner ton test...

L'exemple que tu as repris comparait des valeurs numériques entre elles, d'où l'utilisation de opérateur "<" à l'origine. Comme tu souhaites, chercher des équivalences de chaines de caractères, il convient donc d'utiliser "=" dans ton cas.


Cordialement,
Didier_mDF

 

Créez un compte ou connectez vous pour répondre

Vous devez être membre afin de pouvoir répondre ici

Créer un compte

Créez un compte Excel Downloads. C'est simple!

Connexion

Vous avez déjà un compte? Connectez vous ici.

Haut Bas