Probleme VBA recherche

Question

J'ai un soucis avec une macro qui recherche des mots dans une feuille. Je souhaite que cette macro fasse 3 choses: - rechercher les mots qu'on indique dans l'InputBox dans la feuille 1 - Surligner la ou les lignes dans lesquelles le mot est présent et que ce surlignage s'affiche devant l'utilisateur même s'il est à la ligne 4000 dans mon Excel. - Faire apparaître un message lorsqu'elle ne trouve pas le mot Je mets mon fichier en pièce jointe. Pour le moment, je n'arrive pas à ce que la ligne entière contenant le mot soit surlignée. J'ai également un soucis lorsque je ne rentre aucun mot dans l'InputBox et que je souhaite la fermer. Elle ne se ferme pas, comme si la boucle bouclait à l'infini. Merci beaucoup pour votre aide :) Voici mon code: Sub Rechercher() Cells.Font.Color = 0 b = InputBox("Que recherchez vous? Merci de bien écrire en MAJUSCULE.") Set r = Cells.Find(b, lookat:=xlPart) If Not r Is Nothing Then fa = r.Address Do s = InStr(r.Value, b) While s &lt;&gt; 0 r.Characters(Start:=s, Length:=Len(b)).Font.Color = vbRed s = InStr(s + 1, r.Value, b) Wend Set r = Cells.FindNext(r) Loop Until r Is Nothing Or r.Address = fa Else MsgBox ("Votre recherche ne donne rien") End If End Sub...

ThauThème · Accepted Answer

Bonsoir Gabe et bienvenu, bonsoir le forum,

Si j'ai bien compris... le code modifié :

Sub Rechercher()
Dim O As Worksheet 'déclare la variable O (Onglet)
Dim BE As Variant 'déclare la variable BE (Boîte d'Entrée)
Dim R As Range 'déclare la variable R (Recherche)
Dim PA As String 'déclare la variable PA (Première Adresse)

ActiveWindow.ScrollRow = 1 'affiche la ligne 1 en haut de l'écran
Set O = Worksheets("Feuil1") 'définit l'onglet O
O.Cells.Interior.ColorIndex = xlNone 'sipprime la couleur dans l'onglet O
BE = Application.InputBox("Que recherchez vous ?", "RECHERCHE", Type:=2) 'définit la boîte d'entrée BE
If BE = False Or BE = "" Then Exit Sub 'si bouton [Annulker] ou non renseignée, sort de la procédure
Set R = O.Cells.Find(BE, , xlValues, xlWhole) 'définit la recherche (recherche exacte de BE dans l'onglet O, la casse n'a pas d'importance)
If Not R Is Nothing Then 'condition : s'il existe au moins une occurrence trouvée
    PA = R.Address 'définit l'adresse PA de la première occurrence trouvée
    ActiveWindow.ScrollRow = R.Row 'affiche la ligne de la première occurrence trouvée en haut de l'écran
    Do 'exécute
        O.Rows(R.Row).Interior.ColorIndex = 4 'colore la ligne entière de l'occurrence trouvée en vert
        Set R = Cells.FindNext(R) 'redéfinit la recherche R (occurrence suivante)
    Loop Until R Is Nothing Or R.Address = PA 'boucle tant qu'il existe de nouvelle occurrence ailleurs qu'en PA
Else 'sinon (condition)
    MsgBox ("Votre recherche ne donne rien") 'message
End If 'fin de la condition
End Sub

le fichier :

19gabe-ep-v01.xlsm (19.55 Ko)