Retrouver mots dans un texte grâce à une liste de mots

Bonjour,

Je vais essayer d'être clair :

J'ai une liste d'une centaine de mots sur la feuille 1, et j'ai tapé un très long texte sur la feuille 2.

Est il possible qu'Excel me mette en gras ou en couleur automatiquement (grâce à une formule) les mots du texte répèrtoriés dans la liste de la feuille 1?

Exemple :

Feuille 1 : Pomme, Poire, Chien, Chat, Maison, Voiture

Feuille 2 : En sortant de ma voiture, j'ai donné une poire à mon chien et une pomme à mon chat avant de rentrer à la maison.

Je voudrais que les mots de la phrase (feuille 2) qui sont écrits dans la feuille 1 se mettent en rouge automatiquement.

J'espère avoir été clair.

Merci

Bonjour,

Avec un code macro, c'est possible.

Regarde le fichier joint, la liste de mots en colonne A, et la phrase dans la cellule D1.

Reviens si tu n'y arrives pas

Bon courage

211greenfire-v1.zip (10.16 Ko)

Merci pour ta réponse rapide, c'est EXACTEMENT ce que je recherchais...

Maintenant, étant novice, peux tu m'expliquer en quelques mots comment tu as procédé? Et si je peux le faire en séparant la liste de mots et le texte en 2 feuilles?

Merci beaucoup

Bonjour,

Voici le code commenté :

Option Compare Text 'Permet de s'affranchir des Majuscules/minuscules
Sub Coloriage()
Dim Cel As Range, CelRef As Range 'déclaration des variables
                                    'Cel étant la cellule qu'on va tester dans l'onglet 1
                                    'CelRef étant la cellule contenant la phrase
Dim Pos As Integer 'Nous donnera la position du mot cherché
Set CelRef = Range("D1") 'c'est donc la cellule contenant la phrase
                        'si tu veux la mettre dans l'onglet 2, nommé "Feuil2"
                        'il faudra la définir ainsi : Set CelRef = Sheets("Feuil2").Range("D1")

CelRef.Font.ColorIndex = xlAutomatic 'on remet la police en noire

For Each Cel In Range("A1:A" & Cells(Rows.Count, 1).End(xlUp).Row)
    'on balaie toutes les cellules non vides de la colonne A
    'si tu veux prendre les cellules de l'onglet 1, on ferait ainsi :
    'With Sheets("Feuil1")
    '   For Each Cel In .Range("A1:A" & .Cells(Rows.Count, 1).End(xlUp).Row)
    '   ...
    If Not IsError(Application.Match(Cel, Split(CelRef, " "), 0)) Then
        'Split permet de mettre dans un tableau VBA tous les mots de la phrase
        'qui sont séparés par un espace.
        'Ensuite, on cherche par l'équivalent de Equiv, si la cellule cherchée
        'est présente dans ce tableau
        Pos = InStr(1, CelRef.Value, Cel.Value, 1)
            'Si le mot cherché est présent, on calcule sa position dans la phrase
        CelRef.Characters(Start:=Pos, Length:=Len(Cel.Value)).Font.ColorIndex = 3
            'Et enfin, on colorie ce mot en rouge
    End If
Next Cel 'A la suivante
End Sub

Bon courage

Bonjour,

Ce code est très utile pour moi. Par contre, j'aimerais faire exactement la même chose mais avec plusieurs fois le même mot dans le texte.

Ce code ne met en rouge que le premier mot qu'il a trouvé, si le mot "pomme" est présent plusieurs fois dans le texte, il ne mettra en rouge que le premier.

Suis-je assez clair ?

Merci d'avance

Bonsoir,

Essaie ainsi :

Option Compare Text
Sub Coloriage()
Dim Cel As Range, CelRef As Range
Dim Pos As Integer, NbOcc As Integer, I As Integer
Set CelRef = Range("D1")
CelRef.Font.ColorIndex = xlAutomatic
For Each Cel In Range("A1:A" & Cells(Rows.Count, 1).End(xlUp).Row)
    If Not IsError(Application.Match(Cel, Split(CelRef, " "), 0)) Then
        Pos = 0
        NbOcc = (Len(UCase(CelRef)) - Len(Application.Substitute(UCase(CelRef), UCase(Cel.Value), ""))) / Len(Cel)
        For I = 1 To NbOcc
            Pos = InStr(Pos + 1, CelRef, " " & Cel & " ", 1) + 1
            If CelRef.Characters(Start:=Pos, Length:=Len(Cel.Value)).Text = Cel.Text Then
                CelRef.Characters(Start:=Pos, Length:=Len(Cel.Value)).Font.ColorIndex = 3
            End If
        Next I
    End If
Next Cel
End Sub

Bonne soirée

Merci beaucoup.

C'est exactement ce qu'il me fallait

Bonne soirée et bonnes fêtes


Par contre, est-il possible de surligner en rouge les mots au lieu de les écrire en rouge ?

Merci

Rechercher des sujets similaires à "retrouver mots texte liste"