Discussion :

[liop49]

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 :

Sélectionner tout - Visualiser dans une fenêtre à part

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

[keygen08]

Bonjour

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

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

[MarcelG]

Bonsoir,

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

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

Select Case

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

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.

[Didier Gonard]

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

[liop49]

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 :

Sélectionner tout - Visualiser dans une fenêtre à part

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