Coloration automatique de cellules selon leur contenu

charlesce

XLDnaute Nouveau
Bonjour à tous,

J'ai besoin de votre aide.

Je n'arrive pas, malgré mes tentatives, à colorer les cellules d'une feuille selon le contenu de celles-ci, en se référant à une base de données.

Je m'explique: je cherche à colorer des cellules selon l'information que je tape dans la cellule, par exemple si j'écris JV300 dans la cellule, j'aimerais que celle-ci devienne violette par exemple.

Tout cela en se basant sur une base de références de produits et un code couleur associé selon les familles de produits.

Quelqu'un a-t-il une idée de formule?

Merci d'avance.

Ch
 

Pièces jointes

  • Etiquettes.xls
    22.2 KB · Affichages: 399
  • Etiquettes.xls
    22.2 KB · Affichages: 450
  • Etiquettes.xls
    22.2 KB · Affichages: 452

job75

XLDnaute Barbatruc
Re : Coloration automatique de cellules selon leur contenu

Re,

La macro dans le Module1 :

Code:
Sub Couleurs()
Dim cel As Range, lig As Variant
Sheets("Liste références").Range("B2:B65536").Interior.ColorIndex = xlNone
For Each cel In Sheets("Liste références").Range("B2", Sheets("Liste références").Range("B65536").End(xlUp))
lig = Application.Match(cel, Sheets("Etiquettes").Columns(6), 0)
If IsNumeric(lig) Then cel.Interior.ColorIndex = Sheets("Etiquettes").Cells(lig, 6).Interior.ColorIndex
Next
End Sub

Elle peut être lancée soit par le bouton "Couleurs", soit en entrant ou effaçant des valeurs en colonne B de "Liste références", ce qui lance cette macro (dans le code de la feuille) :

Code:
Private Sub Worksheet_Change(ByVal Target As Range)
If Intersect(Target, Range("B2", Range("B65536").End(xlUp))) Is Nothing Then Exit Sub
Couleurs
End Sub

A+
 

Pièces jointes

  • Etiquettes-1(1).zip
    20.4 KB · Affichages: 51

charlesce

XLDnaute Nouveau
Re : Coloration automatique de cellules selon leur contenu

job75,

C'est incroyable ce que tu as fait!

En revanche, ce que je souhaiterais c'est que les cellules de la Feuille "Etiquettes", c'est-à-dire A1, B1, C1, A3, etc... se colorent en fonction du code qui est entré dans la cellule.

Donc par exemple pour l'exemple pour le ZK1328 (cf. A1) la cellule doit se colorer automatiquement en gris vu que ZK1328 fait partie de la famille PDS.

Tu vois où je veux en venir...?

Merci d'avance pour ton aide!

Ch
 

job75

XLDnaute Barbatruc
Re : Coloration automatique de cellules selon leur contenu

Re,

En effet je n'avais pas compris, maintenant c'est bon.

La macro dans le Module1 :

Code:
Sub Couleurs()
Dim i As Long, ref As Variant, lig As Variant
With Sheets("Etiquettes")
  .Range("A:D").Interior.ColorIndex = xlNone
  For i = 1 To .Range("A65536").End(xlUp).Row Step 2
    ref = Application.VLookup(.Cells(i, 1), Sheets("Liste références").Range("A:B"), 2, 0)
    If Not IsError(ref) Then
      lig = Application.Match(ref, .Columns(6), 0)
      If IsNumeric(lig) Then .Cells(i, 1).Resize(, 4).Interior.ColorIndex = .Cells(lig, 6).Interior.ColorIndex
    End If
  Next
End With
End Sub

Elle peut être lancée soit par le bouton "Couleurs", soit en entrant ou effaçant des valeurs en colonne A de la feuille "Etiquettes", ce qui lance cette macro (dans le code de la feuille) :

Code:
Private Sub Worksheet_Change(ByVal Target As Range)
If Intersect(Target, Columns(1)) Is Nothing Then Exit Sub
Couleurs
End Sub

Edit : je n'avais pas effacé la macro dans "Liste références"...

A+
 

Pièces jointes

  • Etiquettes-1(2).zip
    20.8 KB · Affichages: 42
Dernière édition:

charlesce

XLDnaute Nouveau
Re : Coloration automatique de cellules selon leur contenu

Re,

C'est trop fort! Mais il manque un tout petit truc...

Les lignes se colorent automatiquement alors qu'il faudrait, je crois, que ce soit chaque cellule une par une qui se colore. Dans le sens où si j'ai une ligne avec:

A1 = ZK1328
B1 = R964H
C1 = W796
D1 = FG2798

Cette ligne ne sera pas uniquement grise parce que ce sont des références qui n'appartiennent pas aux mêmes familles de produits:
- A1 sera GRIS (PDS)
- B1 sera VERT FONCE (MERSUTURES)
- C1 sera VERT CLAIR (ETHILON)
- D1 sera BLEU TURQUOISE (PROLENE)

Tu vois ce que je veux dire?

Merci encore.

Ch
 

job75

XLDnaute Barbatruc
Re : Coloration automatique de cellules selon leur contenu

Bonjour charlesce, le forum,

Mais il manque un tout petit truc...

Là je ne pouvais pas deviner ;)

Mais ce n'est pas grave, juste une petite modif.

Edit : pour mon information (car le temps de calcul peut avoir son importance), jusqu'à quelle ligne de la feuille "Etiquettes" peut-on aller dans le fichier réel ???

A+
 

Pièces jointes

  • Etiquettes-1(3).zip
    20.9 KB · Affichages: 57
Dernière édition:

job75

XLDnaute Barbatruc
Re : Coloration automatique de cellules selon leur contenu

Re,

Une amélioration, pour le cas où la dernière cellule remplie en colonne A n'est pas sur la dernière ligne du tableau :

Code:
Sub Couleurs()
Dim [COLOR="Red"]dercel As Range[/COLOR], i As Long, j As Byte, ref As Variant, lig As Variant
With Sheets("Etiquettes")
  .Range("A:D").Interior.ColorIndex = xlNone
[COLOR="red"]  Set dercel = .Range("A:D").Find(What:="*", LookIn:=xlFormulas, _
    SearchOrder:=xlByRows, SearchDirection:=xlPrevious)
  If dercel Is Nothing Then Exit Sub[/COLOR]
  For i = 1 To [COLOR="red"]dercel[/COLOR].Row Step 2
    For j = 1 To 4
      ref = Application.VLookup(.Cells(i, j), Sheets("Liste références").Range("A:B"), 2, 0)
      If Not IsError(ref) Then
        lig = Application.Match(ref, .Columns(6), 0)
        If IsNumeric(lig) Then .Cells(i, j).Interior.ColorIndex = .Cells(lig, 6).Interior.ColorIndex
      End If
    Next
  Next
End With
End Sub

A+
 

Pièces jointes

  • Etiquettes-1(4).zip
    21.7 KB · Affichages: 50

charlesce

XLDnaute Nouveau
Re : Coloration automatique de cellules selon leur contenu

Bonjour,

C'est juste incroyable! Exactement ce dont j'avais besoin.

Pour répondre à ta question, et évaluer ainsi le temps de calcul, je dirais que je me limite à la ligne 200 environ.

Un grand merci pour ta précieuse aide et pour ta rapidité.

Ch
 

Discussions similaires

Statistiques des forums

Discussions
312 683
Messages
2 090 910
Membres
104 693
dernier inscrit
azizou900