Logo GNT
Actualités Tests & Guides Bons Plans
Twitter iPhone pliant OnePlus 11 PS5 Disney+ Orange Livebox Windows 11
Entraide Applications Microsoft Office Excel VBA colorier des cellules sous conditions

VBA colorier des cellules sous conditions

4 réponses
Avatar
L
Bonjour,

Ma question rejoint celle de loulou et je pense bien d'autres.

Je souhaite pour une rangée de celulle A1:D500 par exemple -> si (pour
chaque cellule) la cellule est égale à "texte1" (en chaîne de
caractères) colorier en rouge, "texte2" -> telle couleur, jusqu'à sept
conditions, sinon ne rien faire et passer à la cellule suivante pour
toute ma sélection. Est-il possible de le faire automatiquement de telle
manière que dès que je remplis ma cellule il colore ma cellule qui
répond aux conditions fixées ?

D'avance merci,
Lionel
Signaler un problème avec ce contenu

4 réponses

Supprimer
Cette action est irreversible, confirmez la suppression du commentaire ?
Signaler le commentaire

Veuillez sélectionner un problème

Nudité
Violence
Harcèlement
Fraude
Vente illégale
Discours haineux
Terrorisme
Autre
Avatar
Hervé
Bonsoir Lionel,
Un proc (à adapter bien entendu) pour colorer toute un plage :

Sub Colorer()
Dim Tbl() As String
Dim TblCouleur() As Integer
Dim Plage As Range
Dim Cel As Range
Dim Adr As String
Dim I As Integer

'rempli les tableaux pour le test
For I = 1 To 7
ReDim Preserve Tbl(1 To I)
ReDim Preserve TblCouleur(1 To I)
Tbl(I) = "Texte " & I
TblCouleur(I) = I + 2
Next I

'la plage est dans la feuille "Feuil1"
'et part de A1 à la dernière cellule
'de la colonne D
With Worksheets("Feuil1")
Set Plage = .Range(.[A1], .[D65536].End(3))
End With

'recherche la valeur de chaque élément
'du tableau
For I = 1 To UBound(Tbl)
Set Cel = Plage.Find(Tbl(I), , xlValues)
'si trouvée
If Not Cel Is Nothing Then
Adr = Cel.Address
'colore toutes les cellules correspondantes
Do
Cel.Interior.ColorIndex = TblCouleur(I)
Set Cel = Plage.FindNext(Cel)
Loop While Cel.Address <> Adr
End If
Next I

Set Cel = Nothing
Set Plage = Nothing
Erase Tbl
End Sub

Si tu veux que la cellule active soit colorée après un changement de valeur,
à mettre dans le module de ta feuille :

Private Sub Worksheet_Change(ByVal Target As Range)

Select Case Target
Case "texte 1"
Target.Interior.ColorIndex = 3
Case "texte 2"
Target.Interior.ColorIndex = 4
Case "texte 3"
Target.Interior.ColorIndex = 5
Case "texte 4"
Target.Interior.ColorIndex = 6
Case "texte 5"
Target.Interior.ColorIndex = 7
Case "texte 6"
Target.Interior.ColorIndex = 8
Case "texte 7"
Target.Interior.ColorIndex = 9
Case Else
Target.Interior.ColorIndex = 0
End Select

End Sub

Si toutes les feuilles du classeur sont concernées, utilise les mêmes ligne
de code dans l'évennement "Private Sub Workbook_SheetChange".

Hervé.

"L" a écrit dans le message de news:

Bonjour,

Ma question rejoint celle de loulou et je pense bien d'autres.

Je souhaite pour une rangée de celulle A1:D500 par exemple -> si (pour
chaque cellule) la cellule est égale à "texte1" (en chaîne de
caractères) colorier en rouge, "texte2" -> telle couleur, jusqu'à sept
conditions, sinon ne rien faire et passer à la cellule suivante pour
toute ma sélection. Est-il possible de le faire automatiquement de telle
manière que dès que je remplis ma cellule il colore ma cellule qui
répond aux conditions fixées ?

D'avance merci,
Lionel


Avatar
L
Bonsoir Lionel,
Un proc (à adapter bien entendu) pour colorer toute un plage :
Salut Hervé et merci pour ta réponse que je n'arrive pas à mettre en

place. Il n'y a pas d'erreur mais il ne se passe rien. Peut-être ai-je
mal renseigné les champs ?
Voici un exemple de fichier excel
http://lola2k.free.fr/pub/color_value/chroniq_act.xls
dont j'aimerais colorer les colonnes E à I selon qu'elles correspondent
à certains critères (chaîne de caractères).

Sub Colorer()
Dim Tbl() As String
Dim TblCouleur() As Integer
Dim Plage As Range
Dim Cel As Range
Dim Adr As String
Dim I As Integer

'rempli les tableaux pour le test
For I = 1 To 7
ReDim Preserve Tbl(1 To I)
ReDim Preserve TblCouleur(1 To I)
Tbl(I) = "Texte " & I
faut-il ici modifier quelque chose ?

TblCouleur(I) = I + 2
Next I

'la plage est dans la feuille "Feuil1"
'et part de A1 à la dernière cellule
'de la colonne D
With Worksheets("Feuil1")
Set Plage = .Range(.[A1], .[D65536].End(3))
j'ai modifié le Range

End With

'recherche la valeur de chaque élément
'du tableau
For I = 1 To UBound(Tbl)
Set Cel = Plage.Find(Tbl(I), , xlValues)
'si trouvée
If Not Cel Is Nothing Then
Adr = Cel.Address
'colore toutes les cellules correspondantes
Do
Cel.Interior.ColorIndex = TblCouleur(I)
Set Cel = Plage.FindNext(Cel)
Loop While Cel.Address <> Adr
End If
Next I

Set Cel = Nothing
Set Plage = Nothing
Erase Tbl
End Sub
je ne comprends pas entrer les critères

J'ai bien vu la suite et entré mes critères : remmplacé "texte 1" par
mon 1er critère, etc.
Mais rien de plus ...
Lionel

Si tu veux que la cellule active soit colorée après un changement de valeur,
à mettre dans le module de ta feuille :

Private Sub Worksheet_Change(ByVal Target As Range)

Select Case Target
Case "texte 1"
Target.Interior.ColorIndex = 3
Case "texte 2"
Target.Interior.ColorIndex = 4
Case "texte 3"
Target.Interior.ColorIndex = 5
Case "texte 4"
Target.Interior.ColorIndex = 6
Case "texte 5"
Target.Interior.ColorIndex = 7
Case "texte 6"
Target.Interior.ColorIndex = 8
Case "texte 7"
Target.Interior.ColorIndex = 9
Case Else
Target.Interior.ColorIndex = 0
End Select

End Sub

Si toutes les feuilles du classeur sont concernées, utilise les mêmes ligne
de code dans l'évennement "Private Sub Workbook_SheetChange".

Hervé.

"L" a écrit dans le message de news:

Bonjour,

Ma question rejoint celle de loulou et je pense bien d'autres.

Je souhaite pour une rangée de celulle A1:D500 par exemple -> si (pour
chaque cellule) la cellule est égale à "texte1" (en chaîne de
caractères) colorier en rouge, "texte2" -> telle couleur, jusqu'à sept
conditions, sinon ne rien faire et passer à la cellule suivante pour
toute ma sélection. Est-il possible de le faire automatiquement de telle
manière que dès que je remplis ma cellule il colore ma cellule qui
répond aux conditions fixées ?

D'avance merci,
Lionel






Avatar
L
me réponse précédente un poil rapide. Cela foncitonne bien pour "texte
1", "texte 2", etc.
Je me suis ma expliqué.

Mes conditions à vérifier sont :"zoom", "rotate", "cut", filter",
"translation" et non littéralement "texte 1", "texte 2", etc.

Merci,
Lionel

Bonsoir Lionel,
Un proc (à adapter bien entendu) pour colorer toute un plage :

Sub Colorer()
Dim Tbl() As String
Dim TblCouleur() As Integer
Dim Plage As Range
Dim Cel As Range
Dim Adr As String
Dim I As Integer

'rempli les tableaux pour le test
For I = 1 To 7
ReDim Preserve Tbl(1 To I)
ReDim Preserve TblCouleur(1 To I)
Tbl(I) = "Texte " & I
TblCouleur(I) = I + 2
Next I

'la plage est dans la feuille "Feuil1"
'et part de A1 à la dernière cellule
'de la colonne D
With Worksheets("Feuil1")
Set Plage = .Range(.[A1], .[D65536].End(3))
End With

'recherche la valeur de chaque élément
'du tableau
For I = 1 To UBound(Tbl)
Set Cel = Plage.Find(Tbl(I), , xlValues)
'si trouvée
If Not Cel Is Nothing Then
Adr = Cel.Address
'colore toutes les cellules correspondantes
Do
Cel.Interior.ColorIndex = TblCouleur(I)
Set Cel = Plage.FindNext(Cel)
Loop While Cel.Address <> Adr
End If
Next I

Set Cel = Nothing
Set Plage = Nothing
Erase Tbl
End Sub

Si tu veux que la cellule active soit colorée après un changement de valeur,
à mettre dans le module de ta feuille :

Private Sub Worksheet_Change(ByVal Target As Range)

Select Case Target
Case "texte 1"
Target.Interior.ColorIndex = 3
Case "texte 2"
Target.Interior.ColorIndex = 4
Case "texte 3"
Target.Interior.ColorIndex = 5
Case "texte 4"
Target.Interior.ColorIndex = 6
Case "texte 5"
Target.Interior.ColorIndex = 7
Case "texte 6"
Target.Interior.ColorIndex = 8
Case "texte 7"
Target.Interior.ColorIndex = 9
Case Else
Target.Interior.ColorIndex = 0
End Select

End Sub

Si toutes les feuilles du classeur sont concernées, utilise les mêmes ligne
de code dans l'évennement "Private Sub Workbook_SheetChange".

Hervé.

"L" a écrit dans le message de news:

Bonjour,

Ma question rejoint celle de loulou et je pense bien d'autres.

Je souhaite pour une rangée de celulle A1:D500 par exemple -> si (pour
chaque cellule) la cellule est égale à "texte1" (en chaîne de
caractères) colorier en rouge, "texte2" -> telle couleur, jusqu'à sept
conditions, sinon ne rien faire et passer à la cellule suivante pour
toute ma sélection. Est-il possible de le faire automatiquement de telle
manière que dès que je remplis ma cellule il colore ma cellule qui
répond aux conditions fixées ?

D'avance merci,
Lionel






Avatar
Hervé
Bonsoir Lionel,
Une piste peut être. Dans une autre feuille (ici Feuil2) inscrit tous les
mots en colonne "A" dont tu veux colorer la valeur et cache la feuille
(Format-Feuille-Masquer, si tu veux bien sûr..).
A mettre dans le module du classeur si toutes les feuilles sont concernées,
sinon récupérer que les lignes de code pour les mettre dans la proc
Worksheet_SelectionChange de la feuille concernée.

Private Sub Workbook_SheetChange(ByVal Sh As Object, ByVal Target As Range)
Dim Plage As Range
Dim Cel As Range

'évite "Feuil2" pour colorer les cellules
If Sh.Name = "Feuil2" Then Exit Sub

'défini la plage des mots se trouvant
'dans la colonne "A"
With Worksheets("Feuil2")
Set Plage = .Range(.[A1], .[A63536].End(3))
End With
'recherche le mot dans la liste
Set Cel = Plage.Find(Target, , xlValues)
'si il existe, colore la cellule
'sinon supprime la couleur
'attention, 56 couleurs max
If Not Cel Is Nothing Then
Target.Interior.ColorIndex = Cel.Row + 3
Else
Target.Interior.ColorIndex = 0
End If

Set Cel = Nothing
Set Plage = Nothing

End Sub

Hervé.


"L" a écrit dans le message de news:

me réponse précédente un poil rapide. Cela foncitonne bien pour "texte
1", "texte 2", etc.
Je me suis ma expliqué.

Mes conditions à vérifier sont :"zoom", "rotate", "cut", filter",
"translation" et non littéralement "texte 1", "texte 2", etc.

Merci,
Lionel

Bonsoir Lionel,
Un proc (à adapter bien entendu) pour colorer toute un plage :

Sub Colorer()
Dim Tbl() As String
Dim TblCouleur() As Integer
Dim Plage As Range
Dim Cel As Range
Dim Adr As String
Dim I As Integer

'rempli les tableaux pour le test
For I = 1 To 7
ReDim Preserve Tbl(1 To I)
ReDim Preserve TblCouleur(1 To I)
Tbl(I) = "Texte " & I
TblCouleur(I) = I + 2
Next I

'la plage est dans la feuille "Feuil1"
'et part de A1 à la dernière cellule
'de la colonne D
With Worksheets("Feuil1")
Set Plage = .Range(.[A1], .[D65536].End(3))
End With

'recherche la valeur de chaque élément
'du tableau
For I = 1 To UBound(Tbl)
Set Cel = Plage.Find(Tbl(I), , xlValues)
'si trouvée
If Not Cel Is Nothing Then
Adr = Cel.Address
'colore toutes les cellules correspondantes
Do
Cel.Interior.ColorIndex = TblCouleur(I)
Set Cel = Plage.FindNext(Cel)
Loop While Cel.Address <> Adr
End If
Next I

Set Cel = Nothing
Set Plage = Nothing
Erase Tbl
End Sub

Si tu veux que la cellule active soit colorée après un changement de
valeur,


à mettre dans le module de ta feuille :

Private Sub Worksheet_Change(ByVal Target As Range)

Select Case Target
Case "texte 1"
Target.Interior.ColorIndex = 3
Case "texte 2"
Target.Interior.ColorIndex = 4
Case "texte 3"
Target.Interior.ColorIndex = 5
Case "texte 4"
Target.Interior.ColorIndex = 6
Case "texte 5"
Target.Interior.ColorIndex = 7
Case "texte 6"
Target.Interior.ColorIndex = 8
Case "texte 7"
Target.Interior.ColorIndex = 9
Case Else
Target.Interior.ColorIndex = 0
End Select

End Sub

Si toutes les feuilles du classeur sont concernées, utilise les mêmes
ligne


de code dans l'évennement "Private Sub Workbook_SheetChange".

Hervé.

"L" a écrit dans le message de news:

Bonjour,

Ma question rejoint celle de loulou et je pense bien d'autres.

Je souhaite pour une rangée de celulle A1:D500 par exemple -> si (pour
chaque cellule) la cellule est égale à "texte1" (en chaîne de
caractères) colorier en rouge, "texte2" -> telle couleur, jusqu'à sept
conditions, sinon ne rien faire et passer à la cellule suivante pour
toute ma sélection. Est-il possible de le faire automatiquement de
telle



manière que dès que je remplis ma cellule il colore ma cellule qui
répond aux conditions fixées ?

D'avance merci,
Lionel