Suppression de la ponctuation et de caracteres speciaux

[Scoobidoo]

Bonjour le Forum, bonjour à tous,

Régulièrement, je travaille sur des données et je dois à chaque fois :

• supprimer les données entre parenthèses et les parenthèses

faire l'inventaire

• de la ponctuation (. , : ! ? etc...)

• des caractères spéciaux (& ' ' - _ / etc...)

• des majuscules avec accent

afin de les remplacer soit par un "blanc" soit par des majuscules sans accent. Je le fais par "Menu Remplacer par" et cela nécessite un grand nombre de manipulation. Quelqu'un pourrait il m'éclairer sur le moyen par macro, de les repérer et remplacer car avec mon niveau je suis dans le brouillard complet. D'ailleurs je ne sais même pas si c'est réalisable et je compte sur vous pour me le dire si tel est le cas.
D'avance un grand merci à tous.

Scoobidoo

 

[Pyrof]

Re : Suppression de la ponctuation et de caracteres speciaux

Bonjour,

Voici une amélioration du code de Pierrejean (sans rancune) qui reduit le temps de 0,5 à 0,3.

Pour info je suis un inconditionnel de Scripting.dictionary

Sub suppression2()
' a adapter:ajouter eventuellement la ponctuation a supprimer
'asupp = Array("À", "Á", "Â", "Ã", "Ä", "Å", "È", "É", "Ê", "Ë", "Ì", "Í", "Î", "Ï", "Ù", "Ú", "Û", "Ü", "Ñ", ".", ",", ":", "!", "?", "(", ")", "[", "]", "\", "_", "-", "=", "+", "/")
' a adapter: remplacement du terme avant le ; par le terme qui est après
t = Timer
rempl = Array("À;A", "Á;A", "Â;A", "Ã;A", "Ä;A", "Å;A", "È;E", "É;E", "Ê;E", "#; ", "$; ", """; ", "Ë;E", "Ì;I", "Í;I", "Î;I", "Ï;I", "Ù;U", "Ú;U", "Û;U", "Ü;U", "Ñ;N", ".; ", ",; ", ":; ", "!; ", "?; ", "(; ", "); ", "[; ", "]; ", "\; ", "_; ", "-; ", "=; ", "'; ", "*; ", "+; ", "/; ", "&;AND")

Dim tab1
Set tab1 = CreateObject("scripting.dictionary")
For m = LBound(rempl) To UBound(rempl)
 tab1(Split(rempl(m), ";")(0)) = Split(rempl(m), ";")(1)
Next m

For n = 2 To Range("A65536").End(xlUp).Row
mot = Range("A" & n)
 While InStr(mot, "(") <> 0
    If InStr(mot, ")") = 0 Then
     suite = ""
    Else
      suite = Mid(mot, InStr(mot, ")") + 1)
    End If
  
    mot = Left(mot, InStr(mot, "(") - 1) & suite
  
 Wend

For Each cle In tab1
 mot = Replace(mot, cle, tab1(cle))
Next

Range("E" & n) = Trim(mot)
Next n
MsgBox (Timer - t)
End Sub

Bonne journée à tous

 

[Pyrof]

Re : Suppression de la ponctuation et de caracteres speciaux

Bonjour

Voici une petite modification du code de Pierrejean (sans rancune)

Sub suppression2()
' a adapter:ajouter eventuellement la ponctuation a supprimer
'asupp = Array("À", "Á", "Â", "Ã", "Ä", "Å", "È", "É", "Ê", "Ë", "Ì", "Í", "Î", "Ï", "Ù", "Ú", "Û", "Ü", "Ñ", ".", ",", ":", "!", "?", "(", ")", "[", "]", "\", "_", "-", "=", "+", "/")
' a adapter: remplacement du terme avant le ; par le terme qui est après
t = Timer
rempl = Array("À;A", "Á;A", "Â;A", "Ã;A", "Ä;A", "Å;A", "È;E", "É;E", "Ê;E", "#; ", "$; ", """; ", "Ë;E", "Ì;I", "Í;I", "Î;I", "Ï;I", "Ù;U", "Ú;U", "Û;U", "Ü;U", "Ñ;N", ".; ", ",; ", ":; ", "!; ", "?; ", "(; ", "); ", "[; ", "]; ", "\; ", "_; ", "-; ", "=; ", "'; ", "*; ", "+; ", "/; ", "&;AND")

Dim tab1
Set tab1 = CreateObject("Scripting.dictionary")
For m = LBound(rempl) To UBound(rempl)
 tab1(Split(rempl(m), ";")(0)) = Split(rempl(m), ";")(1)
Next m


For n = 2 To Range("A65536").End(xlUp).Row
mot = Range("A" & n)
 While InStr(mot, "(") <> 0
    If InStr(mot, ")") = 0 Then
     suite = ""
    Else
      suite = Mid(mot, InStr(mot, ")") + 1)
    End If
  
    mot = Left(mot, InStr(mot, "(") - 1) & suite
  
 Wend

For Each cle In tab1
    mot = Replace(mot, cle, tab1(cle))
Next

Range("E" & n) = Trim(mot)
Next n
MsgBox (Timer - t)
End Sub

Le temps passe de 0,5 à 0,3

Je suis un incoditionnel de Scripting Dictionary

Bonnes journée à tous

 

[Pyrof]

Re : Suppression de la ponctuation et de caracteres speciaux

Encore moi

Toutes mes excuses pour avoir envoyé 2 fois la meme chose
J'ai des problèmes de lenteur de mon système et je ne voyaais pas ce que j'avais envoyé ce matin

???????

 

[Scoobidoo]

Re : Suppression de la ponctuation et de caracteres speciaux

Bonjour à tous, Pierrejean, Pyrof, Homepyrof, Dull,

Je suis touché de l'attention que vous portez à la résolution de mes problèmes ainsi qu'à l'optimisation des solutions et je vous en remercie. Je dois m'absenter cette semaine et je ne pourrai par conséquent pas tester les dernières versions proposées. Mais dès mon retour je m'y remets et ne manquerai pas de vous faire un mot pour vous faire part du résultat sur le traitement de mes 6000 lignes et comme le dit Pierrejean de l'éventuelle découverte d'un nouveau cas de bug. Encore un grand merci à tous. A bientôt.

Scoobidoo

 

[S.H]

Re : Suppression de la ponctuation et de caracteres speciaux

Bonjour à tous,

Je souhaiterais en effet utiliser la fonction remplacer dans une macro. J'utilise la suivante :
Cells.Replace What:="à", Replacement:="a", LookAt:=xlPart
Je souhaite faire cela pour toutes les lettres avec accent, la ponctuation : , ; ( ) - _ et les espaces.
Idealement j'aimerais que cela ne concerne que les colonnes I,J et L de mon tableau Excel. Comment puis je faire ?
Merci par avance,
S.H