XL 2013 Mise en forme automatique d'un caractère de cellule conditionnée à une condition

[Chrystel01]

Bonjour,

J'ai un tableau avec divers codes type OFP - OOO - FFP..
Et je souhaiterais qu'une mise en forme soit automatiquement appliquée sur la lettre F par exemple en cheangant sa couleur ou en ajoutant un icone...
J'avais pénsé à la mise en forme conditionnelle mais elle s'applique sur l'ensemble de la cellule...

Avez vous une idée SVP ?

Je vous remercie par avance

Chrystel

 

[Rouge]

Bonjour,

Comment se présente votre tableau?
Le caractère que lequel doit s'appliquer la couleur est-ils toujours le m^me ou bien souhaitez-vous en changer?
Donnez plus de renseignements, éventuellement déposez ici un fichier bidon (sans données confidentielles) construit de la même façon.

Cdlt

 

[job75]

Bonjour Chrystel01,

Voyez le fichier joint et cette macro dans le code de la feuille :

Private Sub Worksheet_Change(ByVal Target As Range)
Dim P As Range, cible$, L%, x$, i%
Set P = Range("A2:A" & UsedRange.Rows.Count) 'plage à étudier, à adapter
If Intersect(Target, [C1]) Is Nothing Then Set Target = Intersect(Target, P) Else Set Target = P
If Target Is Nothing Then Exit Sub
cible = [C1]
L = Len(cible)
Application.ScreenUpdating = False
For Each Target In Target 'si entrées ou effacements multiples (copier-coller)
    x = Target
    If x <> "" Then
        With Target.Font
            .ColorIndex = xlAutomatic 'RAZ
            .Bold = False 'RAZ
        End With
        For i = 1 To Len(Target)
            If Mid(x, i, L) = cible Then
                With Target.Characters(i, L).Font
                    .Color = vbRed 'rouge
                    .Bold = True 'gras
                End With
            End If
        Next i
    End If
Next Target
End Sub

Pas compris ce que vous voulez dire pour l'icône.

Edit : salut Rouge, votre message n'était pas affiché quand j'ai posté le mien.

A+

 

[Chrystel01]

Bonjour,

Je vous remercie ! Cela répond parfaitement à ma demande !
Bon week-end


Chrystel

 

[job75]

Utilisez plutôt ce fichier (2), il faut faire la RAZ en bloc avant la boucle, c'est bien plus rapide :

Private Sub Worksheet_Change(ByVal Target As Range)
Dim P As Range, cible$, L%, x$, i%
Set P = Range("A2:A" & UsedRange.Rows.Count) 'plage à étudier, à adapter
If Intersect(Target, [C1]) Is Nothing Then Set Target = Intersect(Target, P) Else Set Target = P
If Target Is Nothing Then Exit Sub
cible = [C1]
L = Len(cible)
Application.ScreenUpdating = False
With Target.Font
    .ColorIndex = xlAutomatic 'RAZ
    .Bold = False 'RAZ
End With
For Each Target In Target 'si entrées ou effacements multiples (copier-coller)
    x = Target
    For i = 1 To Len(x)
        If Mid(x, i, L) = cible Then
            With Target.Characters(i, L).Font
                .Color = vbRed 'rouge
                .Bold = True 'gras
            End With
        End If
Next i, Target
End Sub

 

[Chrystel01]

Merci beaucoup Job75 !
Je vous souhaite une excellente soirée !