Macro pour colorer cellule d'un onglet en fonction du texte de la cellule

Bonjour

Malgrés quelques recherches je n'arrive pas à trouver de solution à cette question.

Il y a bien entendu le fichier excel pour vous permettre de bien comprendre, et voici le sujet :

sur le premier onglet j'ai en quelque sorte mon paramétrage à savoir que chaque champs à une couleur de fond et de texte qui lui est propre :

le A est en fond rouge et texte noir

le B en fond jaune et texte noir

le F en fond noir et text blanc

etc...

Sur mon deuxième onglet, je vais retrouver ces champs A B C D etc repartis de façon aléatoire et sur deux colonnes et j'aimerais que la couleur du fond et du texte qui est paramétré pour le A de l'onglet 1 viennent automatiquement sur tous les A retrouvé sur l'onglet 2.

Comment faire par macro (ou regle de mise en forme condi ??)

Merci bcp

benjamin

Bonjour,

Avec des MFC

Leakim

merci bcp

j'aurais du préciser un detail : le fichier etait un exemple avec seulement 15 champs différents. Tu as donc pu une apres l'autre mettre une MFC mais en realité dans mon fichier j'ai plusieurs millier de champs diffèrent qui ont chacun un fond coloré particulier et il est impossible de creer une MFC pour chaque.

Enfin, j'ai pris les terme de A, B , C D etc pour exemple mais en réalité, ces champs sont des référence produit qui s'écrivent de millier de façon differentes donc le "gauche" de la MFC est inexploitable. mes ref vont s'appeler par ex : TOTO433, BLABLA36 etc...

je m'excuse je ne pensais pas que mon fichier test porterait à confusion

Y a t il une macro pour cela ?

Bonsoir benjy555, leakim, le forum,

Un essai par macro.....mais si tu as des milliers de références, ça risque de ramer un peu...

Sub Macro1()
 Dim PL1 As Range, PL2 As Range
 Dim CEL As Range, R As Range

 Application.ScreenUpdating = False

  Set PL1 = Sheets("Feuil1").Range("A1").CurrentRegion
  Set PL2 = Sheets("Feuil2").Range("A3").CurrentRegion

   For Each CEL In PL2
    Set R = PL1.Find(CEL.Value, , xlValues, xlWhole)
     If Not R Is Nothing Then
      CEL.Interior.Color = R.Interior.Color
      CEL.Font.Color = R.Font.Color
     End If
  Next CEL
End Sub

Cordialement,

@xorsankukai merci le fichier exemple réagi exactement comme je le demandais

il me reste un pb quand j'adapte cette macro dans mon vrai fichier (bon le nombre de ligne ne me fait pas trop ramer la macro dure quelque dixaine de seconde et c'est bon)

par contre dans mon fichier je ne comprends pas pkoi il n'y a qu'une seule colonne qui se colore correctement alors que dans le fichier exemple il y a bien les deux colonne. Surtout que si je comprends la macro :

For Each CEL In PL2 

Set R = PL1.Find(CEL.Value, , xlValues, xlWhole) 

If Not R Is Nothing 

Then CEL.Interior.Color = R.Interior.Color 

CEL.Font.Color = R.Font.Color

cela implique qu'on recherche n'importe quelle cellule du second onglet non ?

du coup je ne comprends peu être pas ce que veut dire

Set PL2 = Sheets("Feuil2").Range("A3").CurrentRegion

autant pour PL1 je comprends qu'il faut prendre l'onglet source qui contient le code couleur et effectivement la première cellule est en A1 autant pour PL2 je ne comprend pas pourquoi prendre A3 ?

pour info dans mon fichier reel, les deux colonne à colorer sont les colonnes D et G si cela peux t'aider éventuellement à appliquer la macro que sur ces deux là.

Merci bcp

Bonjour,

pour PL2 je ne comprend pas pourquoi prendre A3 ?

Oups ! Erreur lors de la saisie, c'était bien A1 car la plage commence en A1,

dans mon fichier reel, les deux colonne à colorer sont les colonnes D et G

CurrentRegion ne doit pas convenir pour ce cas....d'où l'intérêt de poster un fichier représentatif,

Voici un nouvel essai:

Sub Macro1()
 Dim PL1 As Range, PL2 As Range
 Dim CEL As Range, R As Range
 Dim derlig As Integer

 derlig = Sheets("Feuil2").UsedRange.Rows.Count
 'dernière ligne utilisée de Feuil2

 Application.ScreenUpdating = False

  Set PL1 = Sheets("Feuil1").Range("A1:A" & Sheets("Feuil1").Range("A" & Rows.Count).End(xlUp).Row)
    'Se limite à la colonne A de Feuil1
  Set PL2 = Union(Sheets("Feuil2").Range("D1:D" & derlig), Sheets("Feuil2").Range("G1:G" & derlig))
    'union des plage D1:D et dernière ligne / G1:G et dernière ligne

   For Each CEL In PL2 '................................................boucle sur chaque cellule de PL2
      'CEL.Interior.Color = xlNone: CEL.Font.ColorIndex = xlAutomatic '..sans couleur et couleur police par défaut
    Set R = PL1.Find(CEL.Value, , xlValues, xlWhole) '..................cherche la valeur de la cellule dans PL1
     If Not R Is Nothing Then '.........................................si valeur trouvée
      CEL.Interior.Color = R.Interior.Color '...........................reproduit couleur de fond
      CEL.Font.Color = R.Font.Color '...................................reproduit couleur police
     End If
  Next CEL
End Sub

Cordialement,

bravo et merci bcp c'est parfait