Compter le nombre de mot en rouge, en bleu

Bonjour,

J'aimerais soit une fonction excel soit une macro qui me compte le nombre de mot en rouge dans une case excel.

Est-ce que c'est possible ? Car je trouve que des solution pour compter les mots en fonction du texte écrit.

En sachant que dans les cellule en B il y a mon texte, et en A je voudrais qu'il me calcule le nombre de mots en rouge.

Du type A1 = nombre de mots en rouge dans la cellule B1

A2 = nombre de mots en rouge dans la cellule B2

Merci d'avance

Slt,

un exemple, tu as une fonction CountColour que tu peux utiliser, voir les formules dans la colonne A

Bonjour,

un essai par fonction personnalisée; à tester:

Dans un module standard:

Public Function NbMotRouge(Cellule)
Dim T, i As Integer, Pos As Byte, L As Byte, Nb As Byte
Application.Volatile
    T = Split(Cellule.Value, " ")
    Pos = 1
    For i = LBound(T) To UBound(T)
        L = Len(T(i))
        If Cellule.Characters(Start:=Pos + j, Length:=1).Font.ColorIndex = 3 Then Nb = Nb + 1
        Pos = Pos + Len(T(i)) + 1
    Next
NbMotRouge = Nb
End Function

Et en A1 : =NbMotRouge(B1)

les mots doivent être séparés par un espace

Pas fait de tests très poussés.

A+

Bonjour,

Merci pour ta réponse c'est une super piste de réflexion!

Le seul problème de ton programme VBA est que quand j'ai deux phrases séparées d'un point, le programme me renvoi " #valeur!

Dès que j'enlève la deuxième phrase, le programme remarche.

Comment lui faire comprendre qu'il faut continuer après ?

Ah non, finalement je viens de rajouter un seul mot après un point et ça marche.

Après de nombreux tests, le problème est que j'ai des phrases extrêmement longues, et du coup même en élargissant la colonne au max, j'ai une partie de mon écriture qui va à la ligne et qui est visible que quand je double clique sur ma case. Du coup, le programme me renvoi #VALEURS! dès que j'ai des phrases trop longues, qui vont à la ligne dans ma case.

Soit c'est une histoire de phrase qui va à la ligne, soit il y a un nombre de mots limités.

Est-ce qu'il y a une solution ?

Bonjour,

Ton problème est intéressant et c'est un bon exercice de style.

Je te propose la fonction suivante qui utilise un premier tableau pour compter les mots avec la fonction SPLIT, puis un second tableau à 3 colonnes (col1: mot, col2: position début, col3: longueur mot).

A partir de là une boucle vérifie si la couleur du mot correspond à la couleur passée en paramètre à la fonction (1er paramètre= Référence cellule, 2ème paramètre: couleur recherchée). Cette vérification est effectuée avec la propriété colorindex de l'objet Characters().Font. Un tableau des couleurs figure en commentaires dans la fonction.

Il est possible de passer un troisième paramètre qui correspondra au séparateur. J'ai opté par défaut sur le séparateur "espace".

CODE DE LA FONCTION

Function CompterMotsCouleur(C As Range, Coul As Long) As Long
    '* Valeurs de C pour ColorIndex *
    '* 0=Neutre                     *
    '* 1=Noir                       *
    '* 2=Transparent                *
    '* 3=Rouge                      *
    '* 4=Vert                       *
    '* 5=Bleu foncé                 *
    '* 6=Jaune                      *
    '* 7=Magenta                    *
    '* 8=Bleu ciel                  *
    '* 9=Marron                     *
    '* 10=Vert foncé                *
    '********************************

    On Error GoTo SUITE
    Dim Tableau As Variant
    Dim Compteur As Integer
    Dim Param()
    Dim Texte As String
    Dim i As Integer
    Dim NbMots As Variant
    Dim Position As Integer
    Compteur = 0
    Position = 1
    Texte = C.Value
    Tableau = Split(Texte, " ")
    NbMots = UBound(Tableau)
    ReDim Param(NbMots, 3)
    For i = 0 To UBound(Tableau)
        Param(i, 1) = Position
        Param(i, 2) = Position + Len(Tableau(i)) - 1
        Param(i, 3) = C.Characters(Param(i, 1), Len(Tableau(i))).Font.ColorIndex
        If Param(i, 3) = Coul Then Compteur = Compteur + 1
        Position = Position + Len(Tableau(i)) + 1
    Next i
SUITE:

    CompterMotsCouleur = Compteur
End Function

Exemple d'appel de la fonction (si texte de cellule B2): =COMPTERMOTSCOULEUR(B2;3)

Voilà donc une proposition de solution et en même temps une source de réflexion.

Nota: Mon tableau démarre à 0 alors attention si tu utilises la directive "OPTION BASE 1"

Bon courage

ERRATUM: Mon précédent message

(col1: position début, col2: longueur mot, Col3: Couleur mot)

Désolé !

Merci beaucoup pour ta réponse!

Alors, ton programme fonctionne dans le sens où il ne me renvoi pas de message d'erreur et n'est pas bloqué par la longueur des phrases.

Par contre, j'ai des mots suivi directement d'une virgule mise en noir (ou d'une parenthèse, ou d'un point, enfin de la ponctuation) sans espace, du coup il ne me compte pas ces mots là. Cela a un lien avec la condition dont tu me parles, que je pourrais rajouter ?Peut-être rajouter, en plus de la condition espace, les ponctuations communes du type , . ! ( ) ? - ... ?

Qu'en penses-tu ?

J'ai essayé en mettant mais ça ne marche pas, peut-être que je m'y prends mal

Tableau = Split(Texte, " ", ",", "-", "(", ")", ".", "!", "?", "%", "/")

Bonjour à tous,

j'avais été minimaliste dans la déclaration des variables:

Dim T, i As Integer, Pos As Byte, L As Byte, Nb As Byte

Changer Byte en Integer et ça devrait fonctionner.

A+

Je vous remercie tous les deux, ça marche !!

Bonne journée

J'allais te proposer une solution, mais comme tu as écris "ça marche", je suppose que tu as trouvé.

Je te donne quand même l'info, vu que je me suis un creusé la tête, ça peut toujours servir.

J'ai créé un fonction pour remplacer la fonction SPLIT.

L'avantage c'est que tu peux spécifier toi même dans le code les caractères devant être considérés comme des séparateurs.

Le retour st identique, c'est un tableau.

Voici le code

Function DecoupeChaine(T As String) As Variant
    Dim Tableau()
    Dim debut As Long
    Dim IdTableau As Integer
    IdTableau = 0
    debut = 1
    For i = 1 To Len(T)
        If Mid(T, i, 1) = " " Or Mid(T, i, 1) = "%" Or Mid(T, i, 1) = "," _
        Or Mid(T, i, 1) = "-" Or Mid(T, i, 1) = "." Or Mid(T, i, 1) = "!" _
        Or Mid(T, i, 1) = "?" Then
            ReDim Preserve Tableau(IdTableau)
            Tableau(IdTableau) = Mid(T, debut, i - debut)
            IdTableau = IdTableau + 1
            debut = i + 1
        End If
    Next i

    ReDim Preserve Tableau(IdTableau)
    Tableau(IdTableau) = Mid(T, debut, Len(T) - debut + 1)
    DecoupeChaine = Tableau()
End Function

Exemple d'appel:

Dim TBL As Variant

TBL = DecoupeChaine(Texte)

Je n'ai pas trop testé, alors à déboguer éventuellement (type de paramètre non conforme, chaîne vide,...)

Salut !

Rechercher des sujets similaires à "compter nombre mot rouge bleu"