Remplacer/supprimer automatiquement des mots

Bonjour à tous et à toutes,

Il y a quelques jours, j'avais posé la question sur comment remplacer automatiquement les caractères accentués et les espaces par des caractères non accentués et des tirets.

Patrick1957 (merci à lui) m'avait alors donné le module suivant :

Function MajSansAccent$(ByVal Chaine$)
'Ti
Const VAccent = "àáâãäåéêëèìíîïðòóôõöùúûüç ',", VSsAccent = "aaaaaaeeeeiiiioooooouuuuc--"
Dim Bcle&
For Bcle = 1 To Len(VAccent)
  Chaine = Replace(Chaine, Mid(VAccent, Bcle, 1), Mid(VSsAccent, Bcle, 1))
Next Bcle
MajSansAccent = LCase(Chaine)
End Function

Je l'ai un peu modifié pour ajouter les apostrophes et les virgules.

Aujourd'hui je fais de nouveau appel à vous pour améliorer ce module et ne plus remplacer QUE 1 seul caractère, mais (aussi) des mots. Ainsi, je voudrais AUSSI (en plus pas à la place, c'est pour ça que je parle d'amélioration du module) remplacer/supprimer des mots (donc plusieurs caractères) comme "avec" "et" "de"...

J'ai essayé de le rajouter au code fourni par Patrick1957... :

Const VAccent = "àáâãäåéêëèìíîïðòóôõöùúûüç ', avec ", VSsAccent = "aaaaaaeeeeiiiioooooouuuuc--"

ou

Const VAccent = "àáâãäåéêëèìíîïðòóôõöùúûüç ',"" avec ", VSsAccent = "aaaaaaeeeeiiiioooooouuuuc--"""

... mais le résultat est catastrophique

Si je veux remplacer/supprimer le mot avec, il va me remplacer/supprimer toutes les lettres du mot avec (c'est à dire le A, le V, le E et le C)

Dans un sens c'est logique car l'ordinateur, le programme obéit bêtement en remplaçant les lettres A V E C et non pas le mot AVEC.

Cependant, je ne sais pas comment lui demander de remplacer/supprimer le mot et non les caractères qui le compose quelle que soit la position des caractères.

Je vous remercie par avance pour votre aide.

Bonne journée à vous

Bonjour,

Il n'y a vraiment personne qui puisse m'aider ?

Hello,

Tu veux remplacer les mots "avec" "et" "de" par quoi?

Tu as un exemple de fichier?

Si ça peut relancer ton sujet , voila un code qui fonctionne !!

Sub Multi_FindReplace()

Dim sht As Worksheet
Dim fndList As Variant
Dim rplcList As Variant
Dim x As Long

fndList = Array("avec", "et ","de")
rplcList = Array("tata", "toto", "titi")

'Loop through each item in Array lists
  For x = LBound(fndList) To UBound(fndList)
    'Loop through each worksheet in ActiveWorkbook
      For Each sht In ActiveWorkbook.Worksheets
        sht.Cells.Replace What:=fndList(x), Replacement:=rplcList(x), _
          LookAt:=xlPart, SearchOrder:=xlByRows, MatchCase:=False, _
          SearchFormat:=False, ReplaceFormat:=False
      Next sht

  Next x

End Sub

Bonjour à tous,

Ci-joint une autre proposition à tester.

Les lettres et mots sont dans le code VBA, mais pourraient aussi être dans un onglet caché.

Bouben

Bonjour,

C'est un peu la même méthode !

Tu formes un tableau des mots à supprimer :

motssuppr = Split("avec de et") 'chaîne de tous les mots à supprimer séparés par une espace

Et tu boucles sur le tableau pour épurer ta chaîne.

En reprenant le même schéma :

Function SuppresMots (chaine As String)
    Dim motssuppr, i%
    motssuppr = Split("avec de et")
    For i = 0 To UBound(motssuppr)
        chaine = replace(chaine, motssuppr(i) & " ", "")
    Next i
End Function

NB- Tu aurais mis un fichier permettant d'évaluer le contexte de ton action, la réponse aurait pu être mieux adaptée...

Bonjour à tous et à toutes,

Merci pour vos réponses. J'étais parti en vacances, d'où ma réponse tardive

Finalement, j'ai utilisé la méthode, le fichier de Bouben (merci à lui). J'ai eu un peu de mal à l'adapter à mon fichier et à y intégrer tous les mots que je voulais supprimer/remplacer, mais j'y suis finalement parvenu.

Encore une fois je vous remercie par avance pour vos réponse.

Bonne journée à tous et à toutes