Ceci est une page optimisée pour les mobiles. Cliquez sur ce texte pour afficher la vraie page.

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

thuum

XLDnaute Nouveau
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'aiJe souhaite
17 rue des champs17 Champs
29 Avenue Breteuil29 Breteuil

Merci à vous,
Thuum
 

sousou

XLDnaute Barbatruc
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
 

Rouge

XLDnaute Impliqué
Bonjour,

Etablissez dans une feuille la liste des expressions à exclure, puis avec l'aide d'une fonction personnalisée:
VB:
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
 

Pièces jointes

  • thuum_Supprimer des mots d'une chaine de caractère.xlsm
    15.6 KB · Affichages: 4

Rouge

XLDnaute Impliqué
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.
 

mapomme

XLDnaute Barbatruc
Supporter XLD
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.
VB:
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
 

Pièces jointes

  • thuum- reduction- v1.xlsm
    17.5 KB · Affichages: 1

sylvanu

XLDnaute Barbatruc
Supporter XLD
Bonsoir tout le monde,
Un essai en PJ, simplement avec :
VB:
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.
 

Pièces jointes

  • ED - Mots_supp.xlsm
    16.8 KB · Affichages: 2

Discussions similaires

Les cookies sont requis pour utiliser ce site. Vous devez les accepter pour continuer à utiliser le site. En savoir plus…