format personnalisé

Créer une discussion
Répondre

Boostez vos compétences Excel avec notre communauté !

Rejoignez Excel Downloads, le rendez-vous des passionnés où l'entraide fait la force. Apprenez, échangez, progressez – et tout ça gratuitement ! 👉 Inscrivez-vous maintenant !

S'inscrire
E

eutrophisation

XLDnaute Occasionnel
Bonsoir,

Pourriez vous m'aider à définir 5 couleurs en utilisant le format personnalisé et la mise en forme conditionnelle pour différencier des valeurs entiers et décimales. Le problème se pose d'avantage dans les valeurs décimales. Certaines de mes cellules contiennent des valeurs avec 1 chiffre après la virgule d'autres avec 2 chiffres après la virgule ainsi que 3 chiffres après la virgule. Voudriez vous m'indiquer les formules appropriées pour les nombres décimaux.
Merci de votre attention.
Existe t il des formules dans format personnalisé pour le remplissage des cellules (motif) en dehors de celles proposées par la mise en forme conditionnelle.
Merci pour attention.
 
Trier par date Trier par votes
Re : format personnalisé

Bonjour le fil, le forum,

1) Pour que les limites des classes prennent leur couleur, ajouter ou retrancher une petite valeur :

Code: 
'Sub Ajout()
'à n'exécuter qu'une fois
'Dim r As Range
'For Each r In [R9:U35]
'  If r <> "" Then _
'  r = r + IIf(Left(Cells(r.Row, "V"), 1) = ">", 1, -1) * "1E-9"
'Next
'End Sub
Voyez les valeurs dans la barre de formule pour la plage R9:U35.

2) Pour que la couleur d'une cellule s'adapte quand sa valeur est modifiée j'ai paramétré la macro :

Code: 
Sub CouleurClasse(r As Range)
Dim sens As Integer, n As Variant
For Each r In r
  If r = "" Then
    r.Interior.ColorIndex = xlNone 'RAZ
  Else
    sens = IIf(Left(Cells(r.Row, "V"), 1) = ">", 1, -1)
    n = Application.Match(r, Cells(r.Row, "R").Resize(, 4), sens)
    If IsError(n) Then n = 0
    r.Interior.Color = Cells(r.Row, "R").Offset(, n).Interior.Color
  End If
Next
End Sub
Elle est appelée par ces 2 macros dans le code de la feuille :

Code: 
Private Sub CommandButton1_Click()
CouleurClasse [D9:O35]
End Sub

Private Sub Worksheet_Change(ByVal Target As Range)
Set Target = Intersect(Target, [D9:O35])
If Not Target Is Nothing Then CouleurClasse Target
End Sub
Fichier (2).

A+
 

Pièces jointes

Dernière édition:
Vote positif 0 Vote négatif
Re : format personnalisé

Re,

Si vous ne voulez pas de bouton voici 2 macros à lancer par les touches Ctrl+A ou Ctrl+E :

Code: 
Sub AppliquerCouleur()
'se lance par Ctrl+A
CouleurClasse [D9:O35]
End Sub

Sub EffacerCouleur()
'se lance par Ctrl+E
[D9:O35].Interior.ColorIndex = xlNone
End Sub
Et bien sûr les couleurs s'adaptent toujours aux modifications des cellules.

Fichiers (3) et (3 bis).

A+
 

Pièces jointes

Vote positif 0 Vote négatif
Re : format personnalisé

Re,

La modification des limites des classes sur la plage R9:U35 ne me plaisait pas trop...

Et en effet il suffit de se décaler quand une valeur est égale à une limite :

Code: 
If Application.CountIf(Cells(r.Row, "R").Resize(, 4), r) Then n = n - 1
La macro modifiée :

Code: 
Sub CouleurClasse(r As Range)
Dim sens As Integer, n As Variant
For Each r In r
  If r = "" Then
    r.Interior.ColorIndex = xlNone 'RAZ
  Else
    sens = IIf(Left(Cells(r.Row, "V"), 1) = ">", 1, -1)
    n = Application.Match(r, Cells(r.Row, "R").Resize(, 4), sens)
    If IsError(n) Then n = 0
    If Application.CountIf(Cells(r.Row, "R").Resize(, 4), r) Then n = n - 1
    r.Interior.Color = Cells(r.Row, "R").Offset(, n).Interior.Color
  End If
Next
End Sub
Elle est juste un tout petit peu moins rapide...

Fichiers (4) et (4 bis).

A+
 

Pièces jointes

Dernière édition:
Vote positif 0 Vote négatif
Re : format personnalisé

Re,

Eh bien on voit que vous aimez VBA vous 🙂

Il y a des macros dans tous les sens, mais rien pour les macros du post #35 🙄

Du coup je me demande si vous avez compris ce que je vous ai proposé...

Quoi qu'il en soit voici ce que j'ai fait pour la feuille QUALITE :

1) J'ai d'abord renseigné la plage BM9:BM63 avec des > et des < (vous ne l'avez pas fait).

2) J'ai mis dans le code de la feuille :

Code: 
Private Sub Worksheet_Change(ByVal Target As Range)
Set Target = Intersect(Target, [D9:AR63])
If Not Target Is Nothing Then CouleurClasse Target
End Sub
3) J'ai mis dans Module8 :

Code: 
Sub AppliquerCouleur()
'se lance par Ctrl+A
CouleurClasse [D9:AR63]
End Sub

Sub EffacerCouleur()
'se lance par Ctrl+E
[D9:AR63].Interior.ColorIndex = xlNone
End Sub

Sub CouleurClasse(r As Range)
Dim sens As Integer, n As Variant
r.Interior.ColorIndex = xlNone 'RAZ
For Each r In r
  If r <> "" Then
    sens = IIf(Left(Cells(r.Row, "BM"), 1) = ">", 1, -1)
    n = Application.Match(r, Cells(r.Row, "BI").Resize(, 4), sens)
    If IsError(n) Then n = 0
    If Application.CountIf(Cells(r.Row, "BI").Resize(, 4), r) Then n = n - 1
    r.Interior.Color = Cells(r.Row, "BI").Offset(, n).Interior.Color
  End If
Next
End Sub
4) J'ai affecté les racourcis clavier Ctrl+A et Ctrl+E aux macros concernées.

Le lien pour le fichier http://cjoint.com/?CBksT26hokk

A+
 
Vote positif 0 Vote négatif
Re : format personnalisé

Re,

Ah je n'avais pas fait attention, les cellules des plages à colorer sont calculées par des formules.

Telle quelle, la macro Worksheet_Change que j'ai mise dans la feuille ne servira à rien.

Le plus simple sera de mettre à jour par Ctrl+A. Toutes les cellules étant traitées, ce sera un peu long si toutes les cellules sont renseignées.

On pourrait construire d'autres macros Worksheet_Change pour les plages pilotant les formules, mais là je commence à en avoir plein le dos.

A+
 
Vote positif 0 Vote négatif
Re : format personnalisé

Re,

Toutes les formules dépendent en fait des autres feuilles, donc utiliser une macro Worksheet_Activate.

Mettre uniquement dans le code de la feuille QUALITE :

Code: 
Private Sub Worksheet_Activate()
Dim r As Range, sens As Integer, n As Variant
[D9:W63,AU9:AW63].Interior.ColorIndex = xlNone 'RAZ
For Each r In [D9:W63,AU9:AW63]
  If r <> "" Then
    sens = IIf(Left(Cells(r.Row, "BM"), 1) = ">", 1, -1)
    n = Application.Match(r, Cells(r.Row, "BI").Resize(, 4), sens)
    If IsError(n) Then n = 0
    If Application.CountIf(Cells(r.Row, "BI").Resize(, 4), r) Then n = n - 1
    r.Interior.Color = Cells(r.Row, "BI").Offset(, n).Interior.Color
  End If
Next
End Sub

Sub EffacerCouleur()
'se lance par Ctrl+E
[D9:W63,AU9:AW63].Interior.ColorIndex = xlNone
End Sub
Je maintiens la macro EffacerCouleur, ce peut être utile.

Le lien vers le fichier http://cjoint.com/?CBkxkjpklJk

A+
 
Vote positif 0 Vote négatif
Rejoins nos membres "Supporter XLD" et booste ton expérience Excel !
- Navigue sans publicité
- Accède à Cléa, notre assistante IA experte Excel... et pas que...
- Profite de fonctionnalités exclusives
Ton soutien permet à Excel Downloads de rester 100% gratuit et de continuer à rassembler les passionnés d'Excel.
Je deviens Supporter XLD

Discussions similaires

C
  • Résolu(e)
Microsoft 365 Doublons : mise en surbrillance erronée ?
Réponses
10
Affichages
719
TooFatBoy
TooFatBoy
C
  • Résolu(e)
Microsoft 365 Mise en forme d'une ligne d'après listes déroulantes + clic sur un bouton
Réponses
2
Affichages
647
casualexcel
C
A
  • Question Question
XL 2019 Mise en forme conditionnelle multiple et étirement
Réponses
9
Affichages
590
TooFatBoy
TooFatBoy
D
  • Question Question
Autres MFC si 3 chiffres après la virgule
2
Réponses
17
Affichages
3 K
job75
job75
R
  • Résolu(e)
XL 2010 Problème avec somme de cellules au format monétaire
2
Réponses
16
Affichages
3 K
rosabelle
R
C
  • Résolu(e)
XL pour MAC Format de remplissage
Réponses
14
Affichages
884
choise62
C
Erizion
  • Question Question
XL 2016 Copier la mise en forme d'une cellule MFC
Réponses
1
Affichages
1 K
AtTheOne
AtTheOne
C
  • Résolu(e)
Microsoft 365 SI remplissage cellule (MFC) ALORS transposer la réponse dans une colonne
Réponses
3
Affichages
2 K
Chaine
C
B
  • Résolu(e)
XL 2019 format conditionnel selon texte puis effacer toutes les lettres de la cellule
Réponses
3
Affichages
1 K
Hasco
Hasco
C
  • Question Question
Autres Format euro, dans Textbox, mal renvoyé...
Réponses
9
Affichages
1 K
Christian0258
C
T
  • Question Question
Format de cellule personnalisé
Réponses
12
Affichages
2 K
Titesoeur
T
laurent950
  • Question Question
XL 2013 Les Fonctions personnalisé avec Aide à la saisie et Aide boite de dialogue
Réponses
0
Affichages
3 K
laurent950
laurent950
jeff1494
  • Question Question
Problème format personnalisé 0.##
Réponses
4
Affichages
2 K
Dranreb
Dranreb
maval
  • Question Question
XL 2013 Format cellule
2
Réponses
18
Affichages
2 K
maval
maval
N
  • Question Question
XL 2013 Rajout de ligne et popup d'alerte
Réponses
2
Affichages
1 K
Nicolaij74
N
V
  • Question Question
Microsoft 365 Actualisation formule écrite via macro en liaison avec une BBD
Réponses
2
Affichages
2 K
vynmarius
V
J
  • Question Question
XL 2010 Format personnalisé de nombres avec virgule "effaçable"
Réponses
2
Affichages
937
juju54800
J
flstyle
  • Question Question
XL 2013 Même nombre de chiffre après la virgule qu'une autre cellule
Réponses
5
Affichages
3 K
flstyle
flstyle
L
  • Question Question
Jeux d'icônes
Réponses
11
Affichages
2 K
Modeste geedee
Modeste geedee
D
  • Question Question
XL 2013 Mise en forme conditionnelle du remplissage efface le format police lien hypertexte
Réponses
3
Affichages
1 K
discusagon
D
Retour