Colorer automatiquement les valeurs identiques dans une colonne

jeep54

XLDnaute Nouveau
Bonjour à tous,

J'ai un fichier Excel 2007 d'inventaires qui contient le nom des produits en A et l'emplacement de rangement en B, puis d'autres infos dans les colonnes suivantes.

Existe-t-il un moyen dans Excel de colorer automatiquement tous les lieux identiques de la même couleur, et à chaque changement de valeurs, prendre une autre couleur.

Par exemple, colorer en bleu tous les emplacements "Atelier1", en vert les emplacements "Atelier 2", et ainsi de suite pour x ateliers.

Si en plus, cela peut colorer la ligne entière, ce serait parfait.

Merci d'avance pour votre aide.

Cordialement,
 

jeep54

XLDnaute Nouveau
Re : Colorer automatiquement les valeurs identiques dans une colonne

Bonjour,

Merci pour vos réponses. Mais ma demande est plus complexe.

J'aimerais qu'excel détecte automatiquement toutes les valeurs identiques et les mettent de la même couleur.

Tous les termes "Rondelles" seraient bleus, les termes "vis" serait verts... Peu importe le nombre de termes.

Encore un grand merci pour votre suivi.

Cordialement,
 

jeep54

XLDnaute Nouveau
Re : Colorer automatiquement les valeurs identiques dans une colonne

Bonjour JB,

C'est exactement ce que je cherchais.

Si je peux encore vous demander une petite modification ?

Il faudrait que la couleur des groupes s'applique à la ligne entière.

Encore un grand merci.

JP.
 

BOISGONTIER

XLDnaute Barbatruc
Repose en paix
Re : Colorer automatiquement les valeurs identiques dans une colonne

Code:
Sub GroupColor()
  couleurs = Array(3, 4, 6, 7, 8, 14, 15, 17, 20, 22, 24, 26, 27, 28, 33, 34, 35, 36, 37, 38, 39, 40, 42, 43, 44, 45, 46, 50, 53)
  Set mondico = CreateObject("Scripting.Dictionary")
  For Each c In Range("a2", [a65000].End(xlUp))
    If c <> "" Then mondico.Item(c.Value) = mondico.Item(c.Value) + 1
  Next c
  For Each c In Range("a2", [a65000].End(xlUp))
    If c <> "" Then
      nocoul = (Application.Match(c.Value, mondico.keys, 0)) Mod UBound(couleurs)
      If mondico.Item(c.Value) > 1 Then c.EntireRow.Interior.ColorIndex = couleurs(nocoul)
    End If
  Next c
End Sub

JB
 

Discussions similaires

Statistiques des forums

Discussions
312 243
Messages
2 086 550
Membres
103 245
dernier inscrit
gdesign