Mettre en gras un texte recheché

Bonjour,

J'ai un bordereau, contenant des mots clés que je dois les mettre en gras,

Les mots clés sont cités just a coté dans un autre tableau, la liste peut être modifiée, , d'autre elements peuvent être ajoutés.

Le code VBA doit trouver les mots clés dans le tableau de gauche a partir du tableau de droite, et les met en Gras

Le code ne fonctionne pas, au niveau de la fonction instr,

Quelqu'un peut m'aider ! 

Merci en avance

Sub Mots_clés_en_gras()
Dim O As Worksheet  'variable O  (Onglet)
Dim DLT As Integer   'variable DL (Dernière Ligne)
Dim DLR As Integer   'variable DL (Dernière Ligne Recherche)
Dim PL As Range     'variable PL (PLage)
Dim PR As Range     'variable PR (Produit à Rechercher)
Dim i As Integer
Dim j As Integer

Set O = ActiveSheet 'définit l'onglet O

DLT = O.Cells(Application.Rows.Count, "E").End(xlUp).row 'définit la dernière ligne éditée DL de la colonne E de l'onglet O
DLR = O.Cells(Application.Rows.Count, "M").End(xlUp).row 'définit la dernière ligne éditée DL de la colonne M de l'onglet O

Set PL = O.Range("E5:E" & DLT) 'définit la plage bordereau
Set PR = O.Range("M5:M" & DLR) 'définit la plage recherche

For j = 0 To DLR 'boucle 1 : sur toutes les lignes du bordereau
    For i = 0 To DLT 'boucle 2 : sur tous les produits à rechercher
        'condition : si le produit à recherche est contenu dans la cellule de la boucle

     If InStr(1, LCase(O.Cells(i, "E").Value), LCase(O.Cells(j, "M").Value), vbTextCompare) <> 0 Then

     Cell.Interior.ColorIndex = 4   ' juste pour tester par des couleurs s'il detecte la cellule oups

        End If 'fin de la condition

    Next i 'prochain produit de la boucle 2
Next j 'prochaine ligne de la boucle 1
End Sub

Bonjour Ahmednuance,

Bonjour à tous,

Tu n'as pas précisé quelle cellule il faut colorer...et tes boucles commencent à 0

A tester...

Sub Mots_clés_en_gras()
 Dim O As Worksheet  'variable O  (Onglet)
 Dim DLT As Integer   'variable DL (Dernière Ligne)
 Dim DLR As Integer   'variable DL (Dernière Ligne Recherche)
 Dim PL As Range     'variable PL (PLage)
 Dim PR As Range     'variable PR (Produit à Rechercher)
 Dim i As Integer
 Dim j As Integer

Set O = ActiveSheet 'définit l'onglet O

 DLT = O.Cells(Application.Rows.Count, "E").End(xlUp).Row 'définit la dernière ligne éditée DL de la colonne E de l'onglet O
 DLR = O.Cells(Application.Rows.Count, "M").End(xlUp).Row 'définit la dernière ligne éditée DL de la colonne M de l'onglet O

 Set PL = O.Range("E5:E" & DLT) 'définit la plage bordereau
 Set PR = O.Range("M5:M" & DLR) 'définit la plage recherche
  PL.Interior.ColorIndex = xlNone 'supprime les couleurs existantes

 Application.ScreenUpdating = False 'désactive le rafraichissement de l'écran
   For j = 5 To DLR 'boucle 1 : sur toutes les lignes du bordereau
    For i = 5 To DLT 'boucle 2 : sur tous les produits à rechercher
     If O.Cells(i, "E") <> "" And O.Cells(j, "M") <> "" Then 'si cellule E et cellule M non vides
        'condition : si le produit à recherche est contenu dans la cellule de la boucle
      If InStr(1, LCase(O.Cells(i, "E").Value), LCase(O.Cells(j, "M").Value), vbTextCompare) <> 0 Then
       O.Cells(i, "E").Interior.ColorIndex = 4   ' juste pour tester par des couleurs s'il detecte la cellule oups
      End If 'fin de la condition
     End If
    Next i 'prochain produit de la boucle 2
   Next j 'prochaine ligne de la boucle 1
End Sub

Cordialement,

Bonjour,

Ci-joint le fichier

Merci !

3mots-cles.xlsx (44.90 Ko)

Bonjour à tous,

Un essai....avec une macro que j'avais en stock (merci à l'auteur) et adaptée à ta demande...

5mots-cles.xlsm (54.19 Ko)

Cordialement,

C'est GÉNIAL !!

Merci pour votre contribution , la vitesse de l'exécution du macro est incroyable, d'habitude, avec les boucles ,ça prend du temps

Merci infiniment

Rechercher des sujets similaires à "mettre gras texte recheche"