XL 2013 Rercherche de chaines de caractères puis mise en forme

kev2246

XLDnaute Nouveau
Bonjour tout le monde,

Je viens vers vous pour solliciter votre aide.

En gros, ouvrir un inputbox demandant à l'utilisateur de saisir le mot à chercher. Ensuite, parcourir la feuille entière et mettre en gras tous les mots correspondants à celui saisis par l'utilisateur.

1. J'ai essayé la mise en forme conditionnelle mais ça me met en gras toute la cellule et non pas uniquement le mot que je veux
2. J'ai fait un petit code VBA qui marche sur une colonne mais c'est pas l'utilisateur qui saisi le mot, j'ai mis le mot à chercher directement dans le code, et à chaque fois je dois repartir dans le code pour modifier le mot et c'est un peu casse pied. En plus, ça marche que sur une colonne :
sub test ()
For i=2 to 100
If InStr(1, Range("B" & i).value, "Modèle")>0 Then
Range("B" & i).Characters(InStr(1, Range("B" & i).value, "Modèle"), Len ("Modèle"))
Else

End if
Next i
End sub
 

sylvanu

XLDnaute Barbatruc
Supporter XLD
Bonjour Kev,
Un ex en PJ avec :
VB:
Sub MiseEnForme()
resultat = InputBox("Quel mot recherchez vous ?" & Chr(10) & "( Respectez la casse. )", "Mise en forme")
If resultat <> "" Then
    Range("B2:B1000").Font.Bold = False
    Range("B2:B1000").Font.Color = vbBlack
    For i = 2 To Sheets("Feuil1").Range("B65500").End(xlUp).Row
        If InStr(1, Range("B" & i).Value, resultat) > 0 Then
            Range("B" & i).Characters(InStr(1, Range("B" & i), resultat), Len(resultat)).Font.Bold = True
            Range("B" & i).Characters(InStr(1, Range("B" & i), resultat), Len(resultat)).Font.Color = vbRed
        End If
    Next i
End If
End Sub
 

Pièces jointes

  • Kev.xlsm
    22.3 KB · Affichages: 14

kev2246

XLDnaute Nouveau
Bonjour Sylvanu,

Merci pour ta réponse. Je suis vraiment un débutant sous VBA mais y'a pas moyen d'optimiser la recherche, pour éviter les problèmes de casse (espace, majuscule...)?

Sinon, le code marche bien sur une colonne mais pas sur toute la feuille. Je veux qu'il parcours toutes les lignes et colonnes de mon onglet contenant le texte saisi si possible
 

sylvanu

XLDnaute Barbatruc
Supporter XLD
Vous pouvez fixer la plage de recherche avec :
VB:
Set Plage = [a1].CurrentRegion
qui englobera toute la zone où il y a des cellules non vides. Attention ça peut vite prendre du temps si votre feuille est très grande.
Pour la casse on peut utiliser LCase pour tout ramener en minuscules et ainsi faire abstraction des casses du mot recherché et des mots trouvés.
Cela devient alors :
Code:
Sub MiseEnForme()
Set Plage = [a1].CurrentRegion
resultat = InputBox("Quel mot recherchez vous ?" & Chr(10) & "( Respectez la casse. )", "Mise en forme")
If resultat <> "" Then
    Plage.Font.Bold = False
    Plage.Font.Color = vbBlack
    For Each c In Plage
        If InStr(1, LCase(c), LCase(resultat)) > 0 Then
            c.Characters(InStr(1, c, resultat), Len(resultat)).Font.Bold = True
            c.Characters(InStr(1, c, resultat), Len(resultat)).Font.Color = vbRed
        End If
    Next c
End If
End Sub
A regarder :
 

Pièces jointes

  • Kev2.xlsm
    26.6 KB · Affichages: 3

kev2246

XLDnaute Nouveau
Dernière remarque: En fait comme j'ai beaucoup de textes dans les cellules, il ne met en gras que le premier mot trouvé.

Exemple: si dans la cellule A1 on a : "Texte 1 appartient aussi à Texte 2 mais comme il est non nul alors Texte 1 n'est pas pris en compte".Quand l'utilisateur saisit "Texte 1" La macro met en gras uniquement le premier "Texte 1" et le 2e qui se trouve dans cette même cellule n'est pas en gras
 

Discussions similaires

Réponses
16
Affichages
981

Statistiques des forums

Discussions
311 720
Messages
2 081 925
Membres
101 841
dernier inscrit
ferid87