Recherche d’une chaîne de caractère dans une cellule et la colorier

Recherche d'une chaîne de caractère dans une cellule et colorier la recherche

La fonction "Recherche" (CTRL+F) dans Excel nous offre déjà beaucoup de possibilités, et notamment si on active les options

Mais on peut aussi la personnaliser et notamment obtenir un effet couleur sur la chaîne de caractère recherchée - la colorer en rouge par exemple. Nous devons alors recréer une interface de dialogue sous forme d'un bouton qui appelle la macro (bouton recherche) et une input box qui permettra à l'utilisateur d'entrer son critère

Et voici le résultat de la recherche

Un msg box apparaît et demande si l'on souhaite poursuivre. Si le bouton "oui" est pressé, on obtient

Si le bouton "non" est choisi, les choses reviennent en l'état et le curseur reprend son ancien emplacement

Il est bien sûr possible que le critère de recherche n'existe pas

Le code commenté pour obtenir cet effet

Option Explicit

Sub RechercheEtCouleur()
Dim mot As String, reponse As Integer
Dim oldCel As String

oldCel = Selection.Address 'pour se repositionner ensuite
mot = InputBox(" entrez element a chercher")

ActiveSheet.Select 'repréciser où on est
Range("A1").Select 'se placer en début de recherche
oups: ' va nous permettre de boucler

On Error GoTo fin 'si mot n'existe pas = erreur

Cells.Find(What:=mot, After:=ActiveCell, LookIn:=xlFormulas, LookAt:= _
xlPart, SearchOrder:=xlByRows, SearchDirection:=xlNext, MatchCase:=False _
, SearchFormat:=False).Activate
'effectue la recherche

   With ActiveCell.Characters(Start:=InStr(1, Selection, Left(mot, 1), 1), Length:=Len(mot))
     .Font.ColorIndex = 3 'colorie en rouge
     .Font.Bold = True 'met en gras
    End With

reponse = MsgBox("Poursuivre recherche", vbYesNo) 'nécessaire aussi pour stopper la recherche

If reponse = 6 Then 'si le bouton yes est utilisé
Selection.Font.ColorIndex = 0 'remise de la couleur noire
Selection.Font.Bold = False 'enlever le gras
GoTo oups 'on boucle
Else
Selection.Font.ColorIndex = 0 'idem plus haut si le bouton non est choisi
Selection.Font.Bold = False
Range(oldCel).Select 'on reprend notre place
Exit Sub 'on sort lorsque l'on presse le bouton non
End If

fin:
MsgBox "pas trouvé"
Range(oldCel).Select 'on reprend notre place
End Sub

Remarquez les fonctions ActiveCell.Characters et aussi InStr ("In String"). Ce sont elles qui permettent vraiment d'isoler la chaîne de caractère recherchée

Pour traiter tout le classeur

Pour traiter toutes les feuilles du classeur, on doit recourir à deux procédures différentes. En plus de remplir la fonction recherche, on peut observer ici comment faire "passer" la valeur de deux variables (mot et i) comme paramètres vers une autre procédure

Sub ParcourirFeuilles() 
 Dim i As Integer, mot As String 
 mot = InputBox(" entrez element a chercher") 
 For i = 1 To ThisWorkbook.Sheets.Count 
  Sheets(i).Select 
  Call RechercheEtCouleur(mot, i)
 Next i
 End Sub

Sub RechercheEtCouleur(mot As String, i As Integer)
  Dim reponse As Integer
  Dim oldCel As String
  
  oldCel = Selection.Address 'pour se repositionner ensuite
  ActiveSheet.Select 'repréciser où on est
  Range("A1").Select 'se placer en début de recherche
  
  oups: ' va nous permettre de boucler
  On Error GoTo fin 'si mot n'existe pas = erreur
  
  Cells.Find(What:=mot, After:=ActiveCell, LookIn:=xlFormulas, LookAt:= _
  xlPart, SearchOrder:=xlByRows, SearchDirection:=xlNext, MatchCase:=False).Activate
  'effectue la recherche

  With ActiveCell.Characters(Start:=InStr(1, Selection, Left(mot, 1), 1), Length:=Len(mot))
     .Font.ColorIndex = 3 'colorie en rouge
     .Font.Bold = True 'met en gras
  End With
  
  reponse = MsgBox("Poursuivre recherche", vbYesNo) 'nécessaire aussi pour stopper la recherche
  If reponse = 6 Then 'si le bouton yes est utilisé
     Selection.Font.ColorIndex = 0 'remise de la couleur noire
     Selection.Font.Bold = False 'enlever le gras
     GoTo oups 'on boucle
  Else
     Selection.Font.ColorIndex = 0 'idem plus haut si le bouton non est choisi
     Selection.Font.Bold = False
     Range(oldCel).Select 'on reprend notre place
     Exit Sub 'on sort lorsque l'on presse le bouton non
  End If

  fin:
  If i < ThisWorkbook.Sheets.Count Then
     MsgBox "pas trouvé sur cette page, je continue"
  Else
     MsgBox "pas trouvé dans le classeur ou dans la dernière feuille"
     Range(oldCel).Select 'on reprend notre place
  End If
End Sub

Cliquez ici pour télécharger le fichier exemple RechercheEtColoriageDeLaRecherche

Recherche d'une chaîne de caractère dans une cellule et colorier la recherche

FIN

Avertissement