Sub SupprimeAssociationEtMairie()
Call SupprimeMots(ActiveSheet.UsedRange, "Association,Mairie")
End Sub
'----------------------------------------------------------------------
'Suppression des mots listés dans le paramètre ListeMots séparés par
'des virgules (,) à appliquer dans un Range passé dans le paramètre Rng
'----------------------------------------------------------------------
Sub SupprimeMots(Rng As Range, ListeMots As String)
Dim TabMots() As String
Dim Cellule As Range
Dim Valeur As String
Dim i As Integer
Dim Nb As Integer
TabMots = Split(ListeMots, ",")
If UBound(TabMots) = -1 Then Exit Sub
Nb = 0
For Each Cellule In Rng
If Not IsEmpty(Cellule) Then
If VarType(Cellule) = vbString Then
Valeur = Cellule.Value
For i = LBound(TabMots) To UBound(TabMots)
Valeur = Replace(Valeur, TabMots(i) & " ", "", compare:=vbTextCompare)
Valeur = Replace(Valeur, TabMots(i), "", compare:=vbTextCompare)
Next i
If Len(Valeur) < Len(Cellule.Value) Then
Cellule.Value = Valeur
Nb = Nb + 1
End If
End If
End If
Next Cellule
MsgBox "Mots """ & ListeMots & """ remplacés dans " & Nb & " cellule(s)."
End Sub