(RESOLU)couleur dans cellule via d'autres cellules

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 !

chaelie2015

XLDnaute Accro
Bonjour Forum
Je souhaite afficher une couleur dans les cellules ( de224 au 247) selon le texte affiché dedans.
Dans ces cellules, j’ai une formule.ci dessous le code qui fonctionne parfaitement mais avec ces formules ça marche pas ?
Code:
Private Sub Worksheet_Change(ByVal Target As Range)

   Dim C As Range 'couleurs
If Target.Count > 1 Then Exit Sub

If Not Intersect(Target, [A224:A247,G224:G147]) Is Nothing Then
    For Each C In Sheets(2).Range("couleur")
        If Target.Value = C.Value Then
            Target.Interior.Color = C.Offset(, 1).Interior.Color
        End If
    Next C
End If
End Sub
salutations
 

Pièces jointes

Dernière édition:
Re : couleur dans cellule via d'autres cellules

Pour illustrer,

Tu choisis en ligne 124 et 176 une couleur, la même bien sure.
La ligne 228 à pris le nom de cette couleur, mais ne s'est pas colorée puisqu'elle n'est pas la cible (target) du dernier changement
Double clic dedans et fais entrée, elle va se colorer

d'autre part,
If Not Intersect(Target, [A224:A247]) Is Nothing Then
 

Pièces jointes

Re : couleur dans cellule via d'autres cellules

Bonsoir ST007
J'ai bien compris tes remarques , amis ça n'a pas fonctionné, même pour ce fichier joint
si je sélectionne dans les deux premiers tableaux même couleur normalement je devrai avoir dans le tableau 3 ,la couleur de la cellule selon la couleur saisie ( exemple la 1ere cellule Orange et la 4 eme cellule Grise)😕
 

Pièces jointes

Re : couleur dans cellule via d'autres cellules

Bonne nuit en espérant que ce code te satisfasse
Je m'étais planté, pour supprimer la couleur .....
Code:
Private Sub Worksheet_Change(ByVal Target As Range)

   Dim C As Range, S As Range 'couleurs
If Target.Count > 1 Then Exit Sub

For Each S In Range("A224:A247")
S.Interior.Color = xlNone                           'c'est ici, on efface toutes les couleurs avant de recolorer
For Each C In Sheets(2).Range("couleur")
        If S.Value = C.Value Then
            S.Interior.Color = C.Offset(, 1).Interior.Color
        End If
    Next C
    Next S

End Sub
 
Re : couleur dans cellule via d'autres cellules

Bonsoir
Si ça vous intéresse, j'ai réussi à faire tourner ça dans un module standard :
VB:
Option Explicit
Private Consignes As New Collection

Function EnColoriant(ByVal NomCouleur As String) As String
Dim Cel As Range
Set Cel = [Couleur].Find(What:=NomCouleur, LookIn:=xlValues, _
   LookAt:=xlWhole, SearchOrder:=xlByRows, SearchDirection:=xlNext, _
   MatchCase:=False, SearchFormat:=False)
If Cel Is Nothing Then
   EnColoriant = NomCouleur & " ?…"
   Consignes.Add Array(Application.Caller, &HBABABA)
Else
   EnColoriant = NomCouleur
   Consignes.Add Array(Application.Caller, Cel.Offset(, 1).Interior.Color)
   End If
End Function

Sub EffectuerColoriages()
Dim T()
Do While Consignes.Count > 0
   T = Consignes(1)
   T(0).Interior.Color = T(1)
   Consignes.Remove 1: Loop
End Sub
En mettant ça dans une cellule :
Code:
=EnColoriant("Rouge")
celle ci se colore en rouge s'il y a bien "Rouge" dans la table Couleur en non pas "Rouge " avec un blanc à la fin, et si le module de la feuille contenant la cellule porte :
VB:
Private Sub Worksheet_Calculate()
EffectuerColoriages
End Sub
Edit: et si votre Feuil1 en est équipé, en A224, à propager sur 24 lignes et 4 colonnes :
Code:
=SI(A120=A172;EnColoriant(A120);"…!!!")
ça se colore aussi en cas d'égalité.
 
Dernière édition:
- 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

Réponses
9
Affichages
475
Réponses
14
Affichages
440
  • Question Question
Microsoft 365 worksheet_change
Réponses
29
Affichages
1 K
Réponses
1
Affichages
446
Retour