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 !