XL 2019 Supprimer des mots d'une chaine de caractère

[thuum]

Bonjour à tous,

Il y'a une formule que je cherche depuis bien longtemps consistant à supprimer des mots (contenus dans une liste) dans une chaine de caractère.

Exemple : (Avec une liste des mots que je ne souhaite plus contenant pour cet exemple : rue, avenue. Ma liste réelle en contient plus de 100)

J'ai	Je souhaite
17 rue des champs	17 Champs
29 Avenue Breteuil	29 Breteuil

Merci à vous,
Thuum

 

[sylvanu]

Bonsoir Thuum,
Vous auriez un petit fichier test, ce serait plus simple.

 

[sousou]

bonjour
tu peux essayer cette fonction
Function remplace(phrase, liste) 'phrase est la phrase à modifier, liste est la zone contenant les mots
With phrase
For Each i In liste
r = LCase(i)
n = InStr(1, phrase, r)
If n <> 0 Then
phrase = Left(phrase, n - 1) & Right(phrase, Len(phrase) - n - Len(r)) ' '
End If
Next
remplace = phrase
End With
End Function

 

[thuum]

Bonjour Sylvanu,

En pj, le document.

Bonne réception,
Thuum

 

[Rouge]

Bonjour,

Etablissez dans une feuille la liste des expressions à exclure, puis avec l'aide d'une fonction personnalisée:

Function Suppr_Mots(Chaine As String) As String
    Dim i As Long, DerLig_f2 As Long, Pos
    Dim f2 As Worksheet
    Dim Texte As String
    Set f2 = Sheets("Liste_Exp")
    DerLig_f2 = f2.Range("A" & Rows.Count).End(xlUp).Row
    For i = 1 To DerLig_f2
        Texte = f2.Cells(i, "A")
        Pos = InStr(1, Chaine, Texte, 1)
        If Pos <> 0 Then Chaine = Application.WorksheetFunction.Replace(Chaine, Pos, Len(Texte), " ")
    Next i
    Suppr_Mots = Chaine
End Function

puis la formule : =Suppr_Mots(A1)
Fichier en exemple

Cdlt

Edit: Zut nos messages se sont croisés

 

[thuum]

Bonjour Sousou,

J'essayerai, mais n'étant pas à l'aise avec le VBA (pour le moment) je voulais trouver une formule hors vba.

Merci beaucoup,
Thuum

 

[Rouge]

Voici votre fichier

 

[thuum]

Merci à tous

 

[Rouge]

J'essayerai, mais n'étant pas à l'aise avec le VBA (pour le moment) je voulais trouver une formule hors vba.

Les formules excel fonctionnent avec du code, vous ne connaissez pas le code utilisé pour ces formules pourtant vous les utilisez quand même, pour les formules personnalisées, c'est la même chose, une fois quelles sont écrites vous ne vous souciez plus de savoir ce qui se passe en arrière plan.

 

[sousou]

Dans ton cas ça pourrait donner ceci.
A voir si tu veux gérer la casse

 

[mapomme]

Bonsoir à tous,

A mon avis pas de formule possible.
D'autre part, il sera très difficile de trouver une fonction personnalisée marchant à tous les coups.
La substitution fait appel aux caractères séparateurs (i.e. différents des lettres) et même au sens.

"113 rue docteur Delarue" ou encore "58 rue du Docteur, Trimouille de la basse rue" : comment faire?

Un essai avec une fonction personnalisée gérant le premier cas mais pas le second.

Function reduction(ByVal xquoi As String, xliste As Range) As String
Const lettres = "eaisnrtoludcmpégbvhfqyxjèàkwzêçôâîûùïáüëöíœ@žð"
Dim Liste, Letr, x, deb&, n&

If xliste.Count > 1 Then Liste = xliste.Value Else ReDim Liste(1 To 1, 1 To 1): Liste = xliste.Value
xquoi = "#" & xquoi & "#"
For Each x In Liste
   deb = 1
   Do
      n = InStr(deb, xquoi, x, vbTextCompare)
      If n = 0 Then Exit Do
      If Not estlettre(Mid(xquoi, n - 1, 1)) And Not estlettre(Mid(xquoi, n + Len(x), 1)) Then
         xquoi = Replace(xquoi, x, " ", , 1, vbTextCompare)
      End If
      deb = n + Len(x)
   Loop
Next x
   reduction = Application.Trim(Mid(xquoi, 2, Len(xquoi) - 2))
End Function

Function estlettre(x As String) As Boolean
Const lettres = "eaisnrtoludcmpégbvhfqyxjèàkwzêçôâîûùïáüëöíœ@žð"
   estlettre = InStr(1, lettres, Left(x, 1), vbTextCompare) > 0
End Function

 

[sylvanu]

Bonsoir tout le monde,
Un essai en PJ, simplement avec :

Function Remplacement(Numéro As String, Chaine As String, Plage As Range)
    Dim c As Range, Texte As String
    For Each c In Plage
        Texte = c
        Chaine = Application.Substitute(Chaine, Texte, "")
        Texte = LCase(c)                                    ' Si minuscules
        Chaine = Application.Substitute(Chaine, Texte, "")
        Texte = UCase(c)                                    ' Si majuscules
        Chaine = Application.Substitute(Chaine, Texte, "")
    Next
    Remplacement = Numéro & " " & Chaine
End Function

Moins élaborée que celle de Mapomme, je ne traite que les problèmes de minuscules et majuscules.