XL 2016 Colorier ligne sous condition

Scorpio

XLDnaute Impliqué
Bonjour à vous,

J'aimerais grâce à un code trouvé sur le net colorier avec un click sur le bouton, les lignes que je choisirais dans le MsgBox.
Ca fonctionne, mais pas chaque fois.
Y aurait-il, s'il vous plaît, un membres bien sympa pour me dépanner dans ce code.
Merci et a bientôt
 

Pièces jointes

  • ColorierLigne.xlsm
    19.5 KB · Affichages: 70

jecherche

XLDnaute Occasionnel
Bonjour,

Remplace ta macro par celle-ci ...
Si tu saisis a ou A , ça fonctionnera.
Le nombre de ligne n'importe pas, il y a détection de la dernière ligne.
Code:
Sub coloriageService()
Dim MyRange As Range
Dim Cel As Range
Dim DerLig As Long
Dim Service As String

DerLig = Range("C" & Rows.Count).End(xlUp).Row
Set MyRange = Range("C2:C" & DerLig)
Service = InputBox("Quel service")
Service = UCase(Service)
For Each Cel In MyRange
    If Cel.Value = Service Then
        Range(Cells(Cel.Row, 1), Cells(Cel.Row, 3)).Interior.ColorIndex = 36
    Else
        Range(Cells(Cel.Row, 1), Cells(Cel.Row, 3)).Interior.ColorIndex = xlNone
    End If
Next
End Sub



Jecherche
 
Dernière édition:

Scorpio

XLDnaute Impliqué
Salut jecherche,
Super, merci du service.
Une question si tu me permets; le code fonctionne bien sur une cellule normale si je peux dire ainsi.
Mais si je mets une liste de validation des données, par ex en colonne B, cela ne marche pas.
A++++++ et merci
 

Pièces jointes

  • ColorierLigne.xlsm
    21.3 KB · Affichages: 60

jecherche

XLDnaute Occasionnel
Bonjour,

Change : Service = Ucase(Service)
Pour : Service = UCase(Left(Service, 1)) & Lcase(Right(Service, Len(Service) - 1))
(on peut ainsi rechercher indifféremment : lyon, Lyon ou LYON, qu'il faut comparer au contenu qui est Lyon)



Jecherche
 
Dernière édition:

Scorpio

XLDnaute Impliqué
Re jecherche,
Super, merci beaucoup, j'aimerais juste encore te demander si possible, regarde dans la colonne "B", j'ai ajouter d'autre mot, et bizarrement le code ne fonctionne pas.
A++++ merci
 

Pièces jointes

  • ColorierLigne.xlsm
    23 KB · Affichages: 61

jecherche

XLDnaute Occasionnel
Bonjour,

Plus simple ainsi ...
Code:
Sub coloriageService()
Call EffaceCouleur
Dim MyRange As Range
Dim Cel As Range
Dim DerLig As Long
Dim Service As String

DerLig = Range("B" & Rows.Count).End(xlUp).Row
Set MyRange = Range("B2:B" & DerLig)
Service = InputBox("Quel service")
For Each Cel In MyRange
If UCase(Cel.Value) = UCase(Service) Then
Range(Cells(Cel.Row, 1), Cells(Cel.Row, 3)).Interior.ColorIndex = 36
End If
Next
End Sub



Jecherche
 

Discussions similaires

Réponses
93
Affichages
2 K
Réponses
3
Affichages
267
Réponses
8
Affichages
343
Réponses
6
Affichages
349

Statistiques des forums

Discussions
312 345
Messages
2 087 497
Membres
103 562
dernier inscrit
soso21