compter le nombre de lettre en rouge dans un mot

[nicroq]

Bonjour,
Après avoir consulté l'ensmble du forum je ne trouve pas de réponse pour résoudre mon probleme qui est le suivant :

A1 = fautes
A2 = branches

par exemple le "a" et le "h" sont des lettres en rouge et je voudrai compter le nombre de lettre en rouge dans le mots; existe t il une macro pouvant faire ca?

Cordialement

 

[Efgé]

Re : compter le nombre de lettre en rouge dans un mot

Bonjour nicroq et bienvenu sur le forum,

Une proposition:

[COLOR=blue]Sub[/COLOR] Compte_rouge()
[COLOR=blue]For Each[/COLOR] C [COLOR=blue]In[/COLOR] Sheets("Feuil1").Range("A1:A100")[COLOR=green] 'Plage à adapter[/COLOR]
    [COLOR=blue]For[/COLOR] X = 1 [COLOR=blue]To[/COLOR] Len(C.Value)
        [COLOR=blue]If[/COLOR] C.Characters(X, 1).Font.ColorIndex = 3 [COLOR=blue]Then[/COLOR] Var = Var + 1
    [COLOR=blue]Next[/COLOR] X
    [COLOR=blue]If[/COLOR] Var <> 0 [COLOR=blue]Then[/COLOR] C.Offset(0, 1).Value = Var
    Var = 0
[COLOR=blue]Next[/COLOR] C
[COLOR=blue]End Sub[/COLOR]

Cordialement

 

[pierrejean]

Re : compter le nombre de lettre en rouge dans un mot

Bonjour nicroq

Et bienvenue sur XLD

Avec une fonction personnalisée

Edit : Salut Efgé

 

[nicroq]

Re : compter le nombre de lettre en rouge dans un mot

Merci beaucoup pour la rapidité de votre réponse!!
C'est nikel!!!

Bonne fin de journéé

 

[nicroq]

Re : compter le nombre de lettre en rouge dans un mot

Efgé : Est il possible au lieu de faire de Range(A1:A100) de faire sur toute la colonne A par exemple?

Merci d avance

 

[krissator]

Re : compter le nombre de lettre en rouge dans un mot

essaie de mettre Columns("A:A") à la place de Range(A1:A100) ^^

 

[Efgé]

Re : compter le nombre de lettre en rouge dans un mot

Re nicroq, Bonjour pierrejean, krissator,
Traiter toute la colonne me parait disproportionné 🙄.
On peut la limiter aux cellules de A1 à la dernière cellule non vide avec :

Derligne = Sheets("Feuil1").Range("A" & Rows.Count).End(xlUp).Row
[COLOR=#0000ff]For Each[/COLOR] C [COLOR=blue]In[/COLOR]  Sheets("Feuil1").Range("A1:A" & Derligne)

Cordialement

 

[nicroq]

Re : compter le nombre de lettre en rouge dans un mot

merci efgé c'est exactement ce que je cherchais!!
merci pour tt!!

 

[nicroq]

Re : compter le nombre de lettre en rouge dans un mot

merci efgé c'est exactement ce que je voulais!!

merci pour tt!!

 

[Staple1600]

Re : compter le nombre de lettre en rouge dans un mot

Bonsoir à tous


nicrop:
Puisque tes lunettes sont défectueuses

Je me substitue à toi.

Merci également à Pierrejean (pour sa fonction personnalisée)

PS: Mon interprétation du code d'Efgé

Sub Compte_rougeBis()
Dim r As Range, c As Range, X&, Var&
Set r = Sheets("Feuil1").Columns(1).CurrentRegion.Resize(, 1)
For Each c In r 'Plage à adapter
   For X = 1 To Len(c)
        If c.Characters(X, 1).Font.ColorIndex = 3 Then Var = Var + 1
    Next X
    If Var <> 0 Then c.Offset(0, 1).Value = Var
    Var = 0
Next c
End Sub

 

[Efgé]

Re : compter le nombre de lettre en rouge dans un mot

Re à tous, Bonjour (ou re je ne sais plus) Staple1600,
J'ai laissé passé sans le voir l'oubli de nicroq concernant Pierrejean 😱,
Que ce dernier ne m'en veuille pas.
Pour le

[COLOR=#0000fc]Set[/COLOR] r = Sheets([COLOR=#800000]"Feuil1"[/COLOR]).Columns(1).CurrentRegion.Resize(, 1)

Il faut vraiment que je me familiarise avec ça, c'est mieux.
Merci Staple de ton intervention 🙂
Cordialement

EDIT
Merci aussi a Krissator même s'il reste préférable de commencer par un petit bonjour....

 

[nicroq]

Re : compter le nombre de lettre en rouge dans un mot

merci a tous! mon problème est parfaitement resolu grâce a vous. Bonne soirée

 

[nicroq]

Re : compter le nombre de lettre en rouge dans un mot

En venant d'appliquer la macro, je viens de m'apercevoir d'un petit :

Sub Compte_rougeBis()
Dim r As Range, c As Range, X&, Var&
Set r = Sheets("Feuil1").Columns(1).CurrentRegion.Resize(, 1)
For Each c In r 'Plage à adapter
For X = 1 To Len(c)
If c.Characters(X, 1).Font.ColorIndex = 3 Then Var = Var + 1
Next X
If Var <> 0 Then c.Offset(0, 1).Value = Var
Var = 0
Next c
End Sub

Il se trouve qu'il peut y avoir des cellules vides (pas plus de 5 cellules vides en suivant) et la macro s'arrete a la premiere cellule vide.
Est il possible de depasser ce probleme?
Desolé je suis debutant en macro!
En vous remeciant

 

[Fred44]

Bonsoir le forum,

Une petite modification du code d'Efgé puis celui de Staple1600...

Sub Compte_rouge_Bis()
    r = Sheets("Feuil1").Range("A65536").End(xlUp).Row
    For c = 1 To r  'Plage à adapter
        wd = Cells(c, 1)
        For X = 1 To Len(wd)
            If Cells(c, 1).Characters(X, 1).Font.ColorIndex = 3 Then Var = Var + 1
        Next X
        If Var <> 0 Then Cells(c, 1).Offset(0, 1).Value = Var
        Var = 0
    Next c
End Sub

En fait la macro commence par la dernière cellule de l'onglet et "remonte" jusqu'à la dernière cellule contenant une variable. Ainsi elle saura où s'arrêter tout en traitant tout le tableau.
Bonne chance.

 

[Efgé]

Re : compter le nombre de lettre en rouge dans un mot

Bonjour au fil, au forum,
Une version un peu différente qui résoud aussi le problème des "trous":

[COLOR=blue]Sub[/COLOR] Compte_rouge_4()
Application.ScreenUpdating = [COLOR=blue]False[/COLOR]
[COLOR=blue]For Each[/COLOR] C [COLOR=blue]In[/COLOR] Sheets("Feuil1").UsedRange.Resize(, 1)
    [COLOR=blue]If[/COLOR] C <> "" [COLOR=blue]Then[/COLOR]
        [COLOR=blue]For[/COLOR] X = 1 [COLOR=blue]To[/COLOR] Len(C)
            [COLOR=blue]If[/COLOR] C.Characters(X, 1).Font.ColorIndex = 3 [COLOR=blue]Then[/COLOR] Var = Var + 1
        [COLOR=blue]Next[/COLOR] X
        [COLOR=blue]If[/COLOR] Var <> 0 [COLOR=blue]Then[/COLOR] C.Offset(0, 1).Value = Var
        Var = 0
    [COLOR=blue]End If[/COLOR]
[COLOR=blue]Next[/COLOR] C
Application.ScreenUpdating = [COLOR=blue]True[/COLOR]
[COLOR=blue]End Sub[/COLOR]

Cordialement