Identifier une cellule ayant une couleur de fond

Bonsoir,

J'ai un fichier excel avec un code couleur sur certaines cellules et je voudrais transposer ce fond de couleur de la celule en texte sur la cellule de droite.

Je m'explique :
si A1 est en verte alors mettre dans B1 "conforme"
si A1 est en jaune alors mettre dans B1 "acceptable"
si A1 est en rouge alors mettre dans B1 "non conforme"
si A1 n'a pas de couleur alors rien faire
et on continue comme cà de A1 jusqu'à A15000

J'ai vu que les couleurs en VBA étaient gérées ainsi :

Code:

---

1 2 3 4 5 6 7 8 9 10 11 12 13

With Selection.Interior .ColorIndex = 3 'ROUGE .Pattern = xlSolid End With Range("E8").Select With Selection.Interior .ColorIndex = 6 'JAUNE .Pattern = xlSolid End With Range("E11").Select With Selection.Interior .ColorIndex = 43 'VERT .Pattern = xlSolid

---

Est ce que vous pourriez m'aider à ce sujet ?

Merci par avance

Nini un peu perdu

Bonjour

Code:

---

1 2 3 4 5 6 7 8 9 10

Private Sub valeur_couleur() Dim cell As Range 'Il faut adapté le nom de sheets à votre classeur For Each cell In Sheets("feuil16").Range("a1:a15000") If Cells(cell.Row, 1).Interior.ColorIndex = 3 Then Cells(cell.Row, 2) = "non conforme" 'rouge.non conforme If Cells(cell.Row, 1).Interior.ColorIndex = 6 Then Cells(cell.Row, 2) = "acceptable" 'jaune.acceptable If Cells(cell.Row, 1).Interior.ColorIndex = 43 Then Cells(cell.Row, 2) = "conforme" 'vert.conforme Next cell   End Sub

---

Bonsoir,

Pour plus d'élégance, et de lisibilité, je préfèrerais la méthode

Code:

---

Select Case

---

Code:

---

1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20

Public Sub essai_couleur()   Dim i As Integer Dim lib As String   For i = 1 To 15000 With Cells(i, 1) Select Case .Interior.ColorIndex Case 3 lib = "non conforme" Case 6 lib = "acceptable" Case 43 lib = "non conforme" End Select .Offset(0, 1).Value = lib End With Next i   End Sub

---

Reste à savoir si le nombre 15000 ne peut pas être modulé, c'est à dire défini en fonction du nombre de lignes informées.

Bonjour,

Etant sous 2013, tu pourrais chercher à exploiter des possibilités apparues depuis 2007 et qui devraient se révéler plus rapide que les for each sur des plages conséquentes.

Soit c'est un one shot et tu n'as pas besoin de VBA pour aller vite
Soit ce sont des traitements répétitifs et tu exploites en VBA les pistes que t'a donné l'enregistreur de macro en pensant à exploiter les cellules visibles après un filtre.

Donc de base :

• tu mets un filtre auto sur ta colonne
• tu fais trier par couleur - tu choisis la 1ère
• tu fais filtrer par couleur - tu choisis cette 1ère couleur
• Si ta couleur 1 est le rouge, dans la 1ère cellule à côté du rouge, tu mets conforme
• Tu double-clic sur la poignée de recopie, Excel te recopie conforme sur toutes les cellules adjacentes aux rouges sans avoir à scroller avec la souris...
• tu fais "effacer les filtre..."
• tu reprends le tri par couleur en changeant la couleur et en étendant la sélection
• tu refais un filtre sur cette couleur 2 etc..

C'est bien plus rapide à faire qu'à écrire ;)
Le fait de faire un tri de couleur avant de faire un filtre est destiné à éviter les ruptures de plages si tu as des cases d'autres couleurs, blanches par exemple, ce qui perturberait l'automatisme de la poignée de recopie.
Si toute ta colonne est avec tes 3 couleurs, tu peux ne faire que du filtre ce qui ira encore plus vite...

cordialement,

Didier

Bonjour

Merci pour vos réponse, j'ai du faire une erreur dans le titre car je suis sous 2003 et non 2013.

En tout cas, un grand merci car j'ai pu grace à vous faire un code :

Code:

---

1 2 3 4 5 6 7 8 9 10

Sub valeur_couleur() Dim c As Range   For Each c In Range("E2", [E5000].End(xlUp)) If c.Interior.ColorIndex = 3 Then c.Offset(0, 1) = "Non acceptable" 'rouge.non conforme If c.Interior.ColorIndex = 6 Then c.Offset(0, 1) = "Acceptable" 'jaune.acceptable If c.Interior.ColorIndex = 43 Then c.Offset(0, 1) = "Conforme" 'vert.conforme Next c   End Sub

---

Encore merci

Nini