XL 2016 macro vba

[nouri1]

bonjour tout le monde
je travail avec des tableau excel dont les cellule contient des noms de sociétés et associations, moi ce que je veux faire ; je veux dans les cellule qui contient association ou mairie par exemple je veux supprimer le mot association ou mairie et laisser le nom de l'association ou mairie
exemple 1 ; cellule B3 , contient "association pour les handicaps",moi je veux supprimer le mot "association" et laisser "pour les handicaps"
exemple 2; cellule C5, contient mairie de Villeneuve , je veux supprimer le mot mairie et laisser "Villeneuve"
j'ai besoin d'une macro que je l'applique sur tout le tableau pour supprimer ses deux mots dans tout le tableau

cordialement

 

[Dudu2]

Bonjour,
Ton tableau, c'est un tableau structuré, il a un petit nom ?
Sinon comment en connait-on les limites (la plage utile) ?
D.

 

[Dudu2]

Voici un code à utiliser, à toi de passer le bon Range en argument d'appel de la fonction SupprimeMots(). Ici on traite toute la feuille active.

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

Edit: Après, il y a plus "geek" avec des Replace de Find, mais je préfère la pelle et la pioche 😎

 

[nouri1]

bonjour Dudu2, oui le tableau contient un entête et il est composé de 5 colonnes et 200 lignes

 

[nouri1]

Dudu2, merci pour le code je vais essayer

 

[Dudu2]

le tableau contient un entête et il est composé de 5 colonnes et 200 lignes

Je suppose que tu ne l'as pas défini en tableau structuré.
Donc dans ce cas, et s'il commence en A1:

Sub SupprimeAssociationEtMairie()
    Call SupprimeMots(ActiveSheet.Range("A2:E201"), "Association,Mairie")
End Sub

Sinon adapte le range.

 

[nouri1]

rebonjour Dudu2,
j'ai essayé mais il m'affiche un message derreur comme suit " sub ou fonction non définie

 

[Dudu2]

Je ne sais pas comment tu t'y prends. Voici un exemple.