Retour à la FAQ

RECHERCHER UN MOT, UNE OCCURENCE, LE REPLACER

Comment rechercher un mot dans toutes les feuilles ?
Recherche toutes les occurences d'un mot dans TOUTES les feuilles d'un document Excel

Sub RechercheMot()
'mpfe, auteur inconnu
mot = InputBox("Mot à rechercher ?")
For feuille = 1 To Sheets.Count
Sheets(feuille).Select
Set trouvé1 = Cells.Find(What:=mot)
If Not trouvé1 Is Nothing Then
trouvé1.Activate
étiq:
If MsgBox("Suivant ?", 4) = vbNo Then Exit Sub
Set trouvé2 = Cells.FindNext(After:=ActiveCell)
If trouvé2.Column <> trouvé1.Column Or trouvé2.Row <> trouvé1.Row
Then
trouvé2.Activate
GoTo étiq
End If
End If
Next feuille
End Sub

Comment rechercher un mot et le remplacer par un autre? Denis Michon
Voici deux procédure qui permettent de rechercher un string,
de compter le nombre de fois que le string est présent et de
le remplacer par un autre string. L'une avec le respect de la casse, l'autre non.

Sub RechercheAvecRespectDeLaCase()
Dim MonString As String, FoundCell As Range, Adr As String
Dim LeString As Variant, Compteur As Long, Pos As Integer

MonString = InputBox(Prompt:="Chaîne recherchée.", _
Title:="Rechercher et Remplacer")
If MonString = "" Then Exit Sub

LeString = Application.InputBox(Prompt:= _
"Valeur de remplacement pour cette chaîne: " _
& """" & MonString & """", Title:="Remplacer par")
If LeString = "Faux" Then Exit Sub

With ActiveSheet
Set FoundCell = .Cells.Find(What:=MonString, _
LookIn:=xlValues, LookAt:=xlPart, MatchCase:=True)
If Not FoundCell Is Nothing Then
Adr = FoundCell.Address
Do
Do
Pos = Pos + 1
Pos = InStr(Pos, FoundCell, MonString, vbTextCompare)
If Pos <> 0 Then Compteur = Compteur + 1
ddf = FoundCell.Address

Loop Until Pos = 0
FoundCell = Application.Substitute(FoundCell, MonString, LeString)
Set FoundCell = .Cells.FindNext(After:=FoundCell)
If FoundCell Is Nothing Then Exit Do
If FoundCell.Address = Range(Adr).Address Then Exit Do
Loop While Not FoundCell Is Nothing
End If
End With
MsgBox Compteur & " remplacements a été effectué."
Set FoundCell = Nothing
End Sub

-------------------
-------------------

Sub RechercheSansRespectDeLaCase()
Dim MonString As String, FoundCell As Range, Adr As String
Dim LeString As Variant, Compteur As Long, Pos As Integer

MonString = InputBox(Prompt:="Chaîne recherchée.", _
Title:="Rechercher et Remplacer")
If MonString = "" Then Exit Sub

LeString = Application.InputBox(Prompt:= _
"Valeur de remplacement pour cette chaîne: " _
& """" & MonString & """", Title:="Remplacer par")
If LeString = "Faux" Then Exit Sub

With ActiveSheet
Set FoundCell = .Cells.Find(What:=MonString, _
LookIn:=xlValues, LookAt:=xlPart)
If Not FoundCell Is Nothing Then
Adr = FoundCell.Address
Do
Do
Pos = Pos + 1
Pos = InStr(Pos, FoundCell, MonString, vbTextCompare)
If Pos <> 0 Then Compteur = Compteur + 1
ddf = FoundCell.Address

Loop Until Pos = 0
FoundCell = Application.Substitute(UCase(FoundCell), UCase(MonString), LeString)
Set FoundCell = .Cells.FindNext(After:=FoundCell)
If FoundCell Is Nothing Then Exit Do
If FoundCell.Address = Range(Adr).Address Then Exit Do
Loop While Not FoundCell Is Nothing
End If
End With
MsgBox Compteur & " remplacements a été effectué."
Set FoundCell = Nothing
End Sub

En plus court de AV

Sub Cherch_Rempl()
X = InputBox("Mot cherché ?", "")
If X = "" Then Exit Sub
Y = InputBox(X & " est à remplacer par..?", "")
If Y = "" Then Exit Sub
ActiveSheet.Cells.Replace What:=X, Replacement:=Y, LookAt:=xlPart, _
SearchOrder:=xlByRows, MatchCase:=True
End Sub