Code VBA pour colorer les "z" en rouge

Le 24/07/2010 à 14:50

Bonjour , je recherche un code VBA pour colorer les "z" en rouge pour les colonnes B, D,E,F,J,K et L.

Merci pour votre aide précieuse

Le 24/07/2010 à 16:43

Bonjour ascal44,

Voilà une solution pour les cellules qui ne comportent que la lettre z (en majuscule ou en minuscule)

Sub ZRouge()

Dim LigneSupB As Currency, LigneSupD As Currency, LigneSupE As Currency
Dim LigneSupF As Currency, LigneSupJ As Currency, LigneSupK As Currency, LigneSupL As Currency
Dim L As Currency

'Détermination de la ligne la plus élevée dans chacune des colonnes B, D, E, F, J, K, L
'--------------------------------------------------------------------------------------
LigneSupB = Range("B65536").End(xlUp).Row
LigneSupD = Range("D65536").End(xlUp).Row
LigneSupE = Range("E65536").End(xlUp).Row
LigneSupF = Range("F65536").End(xlUp).Row
LigneSupJ = Range("J65536").End(xlUp).Row
LigneSupK = Range("K65536").End(xlUp).Row
LigneSupL = Range("L65536").End(xlUp).Row

'Coloriage des z en rouge
'------------------------
For L = 1 To LigneSupB
    If UCase(Cells(L, 2)) = "Z" Then Cells(L, 2).Font.ColorIndex = 3
Next L

For L = 1 To LigneSupD
    If UCase(Cells(L, 4)) = "Z" Then Cells(L, 4).Font.ColorIndex = 3
Next L

For L = 1 To LigneSupE
    If UCase(Cells(L, 5)) = "Z" Then Cells(L, 5).Font.ColorIndex = 3
Next L

For L = 1 To LigneSupF
    If UCase(Cells(L, 6)) = "Z" Then Cells(L, 6).Font.ColorIndex = 3
Next L

For L = 1 To LigneSupJ
    If UCase(Cells(L, 10)) = "Z" Then Cells(L, 10).Font.ColorIndex = 3
Next L

For L = 1 To LigneSupK
    If UCase(Cells(L, 11)) = "Z" Then Cells(L, 11).Font.ColorIndex = 3
Next L

For L = 1 To LigneSupL
    If UCase(Cells(L, 12)) = "Z" Then Cells(L, 12).Font.ColorIndex = 3
Next L

End Sub

Ci-joint le fichier correspondant :

17solution01.zip (8.65 Ko)

Voilà maintenant une solution dans le cas où l'on voudrait peindre toutes les lettres "z" qu'elles soient seules ou non dans la cellule :

Sub ZRouge()

Dim LigneSupB As Currency, LigneSupD As Currency, LigneSupE As Currency
Dim LigneSupF As Currency, LigneSupJ As Currency, LigneSupK As Currency, LigneSupL As Currency
Dim L As Currency, Ctr As Currency

'Détermination de la ligne la plus élevée dans chacune des colonnes B, D, E, F, J, K, L
'--------------------------------------------------------------------------------------
LigneSupB = Range("B65536").End(xlUp).Row
LigneSupD = Range("D65536").End(xlUp).Row
LigneSupE = Range("E65536").End(xlUp).Row
LigneSupF = Range("F65536").End(xlUp).Row
LigneSupJ = Range("J65536").End(xlUp).Row
LigneSupK = Range("K65536").End(xlUp).Row
LigneSupL = Range("L65536").End(xlUp).Row

'Coloriage des z en rouge
'------------------------
For L = 1 To LigneSupB
    For Ctr = 1 To Len(Cells(L, 2))
        If Mid(UCase(Cells(L, 2)), Ctr, 1) = "Z" Then
            Cells(L, 2).Characters(Start:=Ctr, Length:=1).Font.ColorIndex = 3
            Range("A1").Select
         End If
    Next Ctr
Next L

For L = 1 To LigneSupD
    For Ctr = 1 To Len(Cells(L, 4))
        If Mid(UCase(Cells(L, 4)), Ctr, 1) = "Z" Then
            Cells(L, 4).Characters(Start:=Ctr, Length:=1).Font.ColorIndex = 3
            Range("A1").Select
         End If
    Next Ctr
Next L

For L = 1 To LigneSupE
    For Ctr = 1 To Len(Cells(L, 5))
        If Mid(UCase(Cells(L, 5)), Ctr, 1) = "Z" Then
            Cells(L, 5).Characters(Start:=Ctr, Length:=1).Font.ColorIndex = 3
            Range("A1").Select
         End If
    Next Ctr
Next L

For L = 1 To LigneSupF
    For Ctr = 1 To Len(Cells(L, 6))
        If Mid(UCase(Cells(L, 6)), Ctr, 1) = "Z" Then
            Cells(L, 6).Characters(Start:=Ctr, Length:=1).Font.ColorIndex = 3
            Range("A1").Select
         End If
    Next Ctr
Next L

For L = 1 To LigneSupJ
    For Ctr = 1 To Len(Cells(L, 10))
        If Mid(UCase(Cells(L, 10)), Ctr, 1) = "Z" Then
            Cells(L, 10).Characters(Start:=Ctr, Length:=1).Font.ColorIndex = 3
            Range("A1").Select
         End If
    Next Ctr
Next L

For L = 1 To LigneSupK
    For Ctr = 1 To Len(Cells(L, 11))
        If Mid(UCase(Cells(L, 11)), Ctr, 1) = "Z" Then
            Cells(L, 11).Characters(Start:=Ctr, Length:=1).Font.ColorIndex = 3
            Range("A1").Select
         End If
    Next Ctr
Next L

For L = 1 To LigneSupL
    For Ctr = 1 To Len(Cells(L, 12))
        If Mid(UCase(Cells(L, 12)), Ctr, 1) = "Z" Then
            Cells(L, 12).Characters(Start:=Ctr, Length:=1).Font.ColorIndex = 3
            Range("A1").Select
         End If
    Next Ctr
Next L

End Sub

Ci-joint le fichier correspondant :

20solution02.zip (10.28 Ko)
Le 25/07/2010 à 09:13

Merci Marmotte c'est parfait.

Le 25/07/2010 à 10:25

Bonjour ascal44,

Vu que tu es satisfait de la réponse, peut-être pourrais-tu indiquer que c'est résolu avec la petite marque verte ?

Le 25/07/2010 à 13:30

Bonjour Marmotte18,

Ta dernière macro simplifiée

Sub essai()
Dim Lg%, j%, i%, Ctr%
    For j = 2 To 12 'colonnes concernées (B:L)
        If j <> 3 And j <> 7 And j <> 8 And j <> 9 Then 'colonnes exclues
            Lg = Cells(65000, j).End(xlUp).Row
            For i = 1 To Lg
                For Ctr = 1 To Len(Cells(i, j))
                    If Mid(UCase(Cells(i, j)), Ctr, 1) = "Z" Then
                        Cells(i, j).Characters(Start:=Ctr, Length:=1).Font.ColorIndex = 3
                    End If
                Next Ctr
            Next i
        End If
    Next j
End Sub

Amicalement

Claude

Le 25/07/2010 à 19:58

Bonsoir Mr Dubois votre code est intéressant car il est court.

Le problème c'est qu'il traite aussi les "x" composant les mots : xavier , maximum

Pourrait on l'appliquer seulement aux "x" isolés ?

Le 27/07/2010 à 21:48

Bonsoir à tous,

Envoie un bout de fichier avec des exemples de données représentatives,

au début tu parlais de "Z" et maintenant de "X", ces lettres sont-elles des variables ?

si oui, comment les définir ?

1) dans une cellule

2) par InputBox

S'agit-il vraiment d'un caractère isolé "X" seul ou la 1ère lettre d'un mot (comme Xavier)

retire le résolu si tu souhaite continuer ce poste

Amicalement

Claude

Le 28/07/2010 à 09:58

Bonjour , voici ma dernière solution:

Sub essai()
Dim Lg%, j%, i%, Ctr%
Application.ScreenUpdating = False
   For j = 2 To 12 'colonnes concernées (B:L)
       If j <> 3 And j <> 7 And j <> 8 And j <> 9 Then 'colonnes exclues
           Lg = Cells(65000, j).End(xlUp).Row
            For i = 1 To Lg
                If LCase(Cells(i, j).Value) = "x" Then Cells(i, j).Font.ColorIndex = 3

            Next i
      End If
    Next j

End Sub
Le 28/07/2010 à 11:18

Bonjour,

Si çà te va, Ok

mais la macro ne traite que les "x" (pas de variable !)

à+.... Claude

Rechercher des sujets similaires à "code vba colorer rouge"