Discussion :

[kabidan]

Bonjour

Dans une cellule d'excel où se trouve un texte dont certains mots sont en couleurs, est-il possible de sélectionner ces mots pour les remplacer par des données issues d'autres feuilles du même classeur ?

Le texte peut avoir plusieurs mots d'une même couleur, par exemple :
"ceci est un exemple de texte avec des mots à rechercher"

À chaque couleur est associée une feuille (bleue = feuille1, rouge = feuille2, verte = feuille3, etc).

Au résultat les mots en couleurs sont remplacés pas des informations issues d’autres feuilles et selon la couleur.

J’arrive à sélectionner un mot de couleur lorsqu’il est seul dans une cellule mais je ne vois pas comment sélectionner plusieurs mots au sein d’un texte.

Des suggestions ?
Merci à vous

[illight]

Une idée en vrac d'algorithme :

- tu met dans une variable tableau via un split sur le caractère espace (en espérant que tes phrases sont bien des phrases et que les mots sont toujours séparés par des espaces ?) pour avoir un mot pour chaque partie du tableau
- tu regardes dans ce tableau la couleur de ton texte => tu place la valeur trouvée dans ta variable. Pour celle-ci soit :
- tu met un champ texte si tu es sur qu'il n'y a qu'un mot de couleur
- soit tu créé une variable tableau par couleur, et tu met ton mot dedans à chaque fois.

Au final, tu auras alors une variable tableau par couleur, avec tous els mots que tu veux de la couleur

En code, ça donnerai un truc de ce genre :

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
 
Sub toto()
 
Dim phrase() As String
Dim TabBleu() As String
Dim IBleu As Long
Dim tabVert() As String
Dim IVert As Long
IBleu = 0
IVert = 0
'si ta phrase est en A1
phrase = Split(Range("A1").Value, " ")
For i = LBound(phrase) To UBound(phrase)
    If phrase(i).Font.Color.Font = blue Then    'à vérifier pour récupérer la valeur des caracteres
        TabBleu(IBleu) = phrase(i)
        IBleu = IBleu + 1
    ElseIf phrase(i).Font.Color.Font = green Then
        TabBleu(IVert) = phrase(i)
        IVert = IVert + 1
    End If
Next i
End Sub

A toi de l'agrémenter avec ce que tu souhaites

[kabidan]

Merci Illight
certaines entités à chercher sont constituées de plusieurs mots avec des espaces

[illight]

Merci Illight
certaines entités à chercher sont constituées de plusieurs mots avec des espaces

C'est-à-dire ?

Comme "cent vingt-sept" ? effectivement c'est "2 mots" en 1 mot..Mais vu que ta variable tableau va tout mettre à la suite, ça peut pas marcher quand même ?

[kabidan]

je n'aurais peut-être pas dû utiliser le terme "mot" car si dans certains cas il s'agit bien d'un mot unique, dans d'autres il peut s'agir de 2 mots séparés d'un espace (par ex le prénom et nom d'une personne : Jean Dupont). Dans tous les cas le mot unique ou le groupe de mots constituent une seule entité qu'il faut chercher.

[illight]

A ce moment, il faut que tu boucle sur chaque caractère de ton texte, et regarder la couleur, et dès que tu changes de couleur, tu change de cible.

Un truc dans ce genre pour ta boucle :

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
Sub toto()
 
Dim TabBleu() As String
Dim IBleu As Long
Dim tabVert() As String
Dim IVert As Long
IBleu = 0
IVert = 0
'si ta phrase est en A1
For i = 1 To len(range("A1"))
    If mid(range("A1"),i,1).font.color = blue Then    'à vérifier pour récupérer la valeur des caracteres
        TabBleu(IBleu) = phrase(i)
        IBleu = IBleu + 1
    ElseIf phrase(i).Font.Color.Font = green Then
        TabBleu(IVert) = phrase(i)
        IVert = IVert + 1
    End If
Next i
End Sub

Après, tes simples If tu peux les remplacer par des While, pour pouvoir avoir tout ton "mot". Un truc comme ça (attention je te donne les idées, j'ai aps testé le code) !

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
 
While i <= Len(Range("A1"))
    nb = 1
    While Mid(Range("A1"), i, 1).Font.Color = blue  'à vérifier pour récupérer la valeur des caracteres
        nb = nb + 1
        i = i + 1
    Wend
    TabBleu(IBleu) = Mid(Range("A1"), i, nb)
    IBleu = IBleu + 1
    While Mid(Range("A1"), i, 1).Font.Color = green  'à vérifier pour récupérer la valeur des caracteres
        nb = nb + 1
        i = i + 1
    Wend
    TabBleu(IVert) = Mid(Range("A1"), i, nb)
    Iverrt = IVert + 1
    i = i + 1
Wend