Couleur de cellules et VBA

Résolu/Fermé

amiralS Messages postés 46 Date d'inscription samedi 26 octobre 2013 Statut Membre Dernière intervention 21 février 2020 - 3 nov. 2018 à 11:07
amiralS Messages postés 46 Date d'inscription samedi 26 octobre 2013 Statut Membre Dernière intervention 21 février 2020 - 3 nov. 2018 à 12:58

Bonjour,

Je souhaite avec du code VBA mettre en couleur les cellules non contiguës qui répondent à une condition.
J'ai une feuille de résultats d'une course et je ne veux pas appliquer la couleur choisie sur toute la ligne concernée par la condition mais seulement des cellules pas forcément contiguës sur cette ligne.

Sub MacroCouleur() 'Mettre des cellules en couleur en fonction du nom de l'établissement (MRiviere )dans la colonne E.
Ma macro ci dessous:

Dim finligne As Byte
Dim NumeroLigne As Byte

finligne = ActiveSheet.UsedRange.Rows.Count + 1 'Variable nombre de lignes
NumeroLigne = 2 'Variable ligne en cours

While NumeroLigne < finligne

If Range("E" & NumeroLigne).Value = "MRiviere" Then Range("B" & NumeroLigne).Interior.Color = RGB(0, 255, 0)
If Range("E" & NumeroLigne).Value = "MRiviere" Then Range("E" & NumeroLigne).Interior.Color = RGB(0, 255, 0)
If Range("E" & NumeroLigne).Value = "MRiviere" Then Range("F" & NumeroLigne).Interior.Color = RGB(0, 255, 0)
NumeroLigne = NumeroLigne + 1

Wend

End Sub

Pour faire court comment je peux mettre dans un seul If les 3 ci-dessus?

Merci pour votre réponse.
amiralS

A voir également:

Récupérer le code couleur rgb d'une cellule excel
Excel cellule couleur si condition texte - Guide
Liste déroulante excel - Guide
Aller à la ligne dans une cellule excel - Guide
Verrouiller cellule excel - Guide
Compte piraté facebook comment le recuperer - Guide

3 réponses

Réponse 1 / 3

fabien25000 Messages postés 673 Date d'inscription mercredi 5 octobre 2016 Statut Membre Dernière intervention 28 juillet 2022 59
Modifié le 3 nov. 2018 à 11:22

Bonjour,

While NumeroLigne < finligne 

If Range("E" & NumeroLigne).Value = "MRiviere" Then 
    Range("B" & NumeroLigne).Interior.Color = RGB(0, 255, 0)
    Range("E" & NumeroLigne).Interior.Color = RGB(0, 255, 0)
    Range("F" & NumeroLigne).Interior.Color = RGB(0, 255, 0)
end if
NumeroLigne = NumeroLigne + 1 

Wend

c'est ça que tu cherches?
Pourquoi ne pas utiliser simplement la MFC?

Réponse 2 / 3

amiralS Messages postés 46 Date d'inscription samedi 26 octobre 2013 Statut Membre Dernière intervention 21 février 2020 2
3 nov. 2018 à 12:12

Merci,
Le code fonctionne mais je me demandais s'il était possible de faire encore plus court et ne pas répéter à chaque fois .Interior.Color = RGB(0, 255, 0).

Par exemple:
If Range("E" & NumeroLigne).Value = "MRiviere" Then Range("A" & NumeroLigne, "I" & NumeroLigne).Interior.Color = RGB(0, 255, 0)
Dans ce cas toutes les cellules contigües de "E" à "I" sont remplies en vert, la virgule sert de séparateur.
Entre les parenthèses après Then Range n'est il pas possible de mettre des séparateurs pour indiquer quelles cellules je veux remplir en vert?

Je n'ai pas pensé à la MFC et je ne vois pas quelle règle je devrais adopter.

Merci pour ton aide

yg_be Messages postés 22733 Date d'inscription lundi 9 juin 2008 Statut Contributeur Dernière intervention 29 avril 2024 1 477
3 nov. 2018 à 12:34

bonjour, ceci?

Range("B" & NumeroLigne & ",E" & NumeroLigne & ",F" & NumeroLigne).Interior.Color = RGB(0, 255, 0)

amiralS Messages postés 46 Date d'inscription samedi 26 octobre 2013 Statut Membre Dernière intervention 21 février 2020 2
3 nov. 2018 à 12:57

Merci yg_be pour cette réponse qui me va très bien pour alléger mon code

Réponse 3 / 3

michel_m Messages postés 16603 Date d'inscription lundi 12 septembre 2005 Statut Contributeur Dernière intervention 16 décembre 2023 3 303
Modifié le 3 nov. 2018 à 12:42

Bonjour

Option Explicit
'--------------------
Sub MacroCouleur() 'Mettre des cellules en couleur en fonction du nom de l'établissement (MRiviere )dans la colonne E.

Dim finligne As Byte
Dim NumeroLigne As Byte
Dim Nbre As Byte, Cptr As Byte
finligne = ActiveSheet.UsedRange.Rows.Count + 1 'Variable nombre de lignes
NumeroLigne = 2 'Variable ligne en cours
'on ne boucle le nbre de fpois où il y a MRiviere
Nbre = Application.CountIf(Columns("E"), "MRiviere")
If Nbre > 0 Then
    For Cptr = 1 To Nbre
        NumeroLigne = Columns("E").Find("MRiviere", Cells(NumeroLigne, "E"), xlValues).Row
        Range("B" & NumeroLigne & ",E" & NumeroLigne & ",F" & NumeroLigne).Interior.Color = RGB(0, 255, 0)
      
 Next
End If

End Sub

amiralS Messages postés 46 Date d'inscription samedi 26 octobre 2013 Statut Membre Dernière intervention 21 février 2020 2
3 nov. 2018 à 12:58

Bonjour et merci pur cette réponse qui fonctionne aussi très bien d'une autre manière de coder et je retiens.

Discussions similaires

sertissage des cables rj45

Formule Excel : "SI" une cellule contient un mot, alors ?

Discussions similaires

Newsletters