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

 

[Dull]

Re : Suppression de la ponctuation et de caracteres speciaux

Salut Scoobidoo, Le Forum

Un Essai en Piéce Jointe

Sur un Bien Beau Code de l'Ami Gruick🙂

Sub SansPonctuation() 'By Gruick
' Remplace tous les caractères spéciaux par leur équivalent naturel
' Définition de la conversion
Const Ponctuation As String = "ÀÁÂÃÄÅÈÉÊËÌÍÎÏÙÚÛÜÑ.,:!?()[]\_-&=+/"
Const NoPonctuation As String = "AAAAAAEEEEIIIIUUUUN                "
Dim i As Integer, C As Range
Dim lettre As String * 1
For Each mot In Selection
For Each C In Selection
    C = Split(Trim(C), " (")
Next C
  For i = 1 To Len(Ponctuation)
    lettre = Mid$(Ponctuation, i, 1)
    If InStr(mot, lettre) > 0 Then
      Nllelettre = Mid$(NoPonctuation, i, 1)
      mot.Replace what:=lettre, replacement:=Nllelettre, lookat:=xlPart
    End If
  Next i
Next mot
For Each C In Selection
    C = Application.Trim(C)
Next C
End Sub

EDITION: Bien sur il faut faire la sélection au préalable

Bonne Journée

 

[Scoobidoo]

Re : Suppression de la ponctuation et de caracteres speciaux

Bonjour Dull, le forum,

Je viens de regarder sur le bout de fichier joint et le résultat est encourageant mais pas exactement ce dont j'ai besoin. En effet, il me faut d'une part de conserver les données d'origine, et d'autre part d'extraire les données entre parenthèses qui seront supprimées en colonne 2, de répertorier les caractères, ponctuation majuscules etc qui seront supprimés en colonne 3 et que le résultat après traitement s'affiche en colonne 4. Si tu pouvais m'aider pour que cela corresponde ce serait sympa. De mon coté je plancherai dessus dès cet après midi. Encore merci à toi et à Gruick bien entendu.

Scoobidoo

 

[pierrejean]

Re : Suppression de la ponctuation et de caracteres speciaux

bonjour Scoobidoo

Vois si ceci te convient (a adapter)

Sub suppression()
' a adapter:ajouter eventuellement la ponctuation a supprimer
asupp = Array(":", ";", "-")
' a adapter: remplacement du terme avant le ; par le terme qui est après
rempl = Array("&;AND")
For n = 2 To Range("A65536").End(xlUp).Row
mot = Range("A" & n)
 While InStr(mot, "(") <> 0
    mot = Left(mot, InStr(mot, "(") - 1) & Mid(mot, InStr(mot, ")") + 1)
 Wend
For m = LBound(asupp) To UBound(asupp)
 mot = Replace(mot, asupp(m), "")
Next m
For m = LBound(rempl) To UBound(rempl)
 mot = Replace(mot, Split(rempl(m), ";")(0), Split(rempl(m), ";")(1))
Next m
Range("E" & n) = Trim(mot)
Next n
End Sub

 

[Scoobidoo]

Re : Suppression de la ponctuation et de caracteres speciaux

Bonjour Pierrejean, le forum

Je te remercie de ta réponse que je vais tenter d'adapter selon les instructions notées. Je te présente mes excuses pour ma réponse tardive mais j'étais en panne de machine. Aujourd'hui cela semble fonctionner et je peux donc reprendre mes activités. Je reviendrai vers vous pour vous dire ce que j'aurai réussi à faire ou à ne pas faire selon. Bonne journée à tous.

Scoobidoo

 

[Scoobidoo]

Re : Suppression de la ponctuation et de caracteres speciaux

Re bonjour Pierrejean, le forum

J'ai adapter ta proposition à mon besoin et cela fonctionne correctement si je fais un essai sur une vingtaine de lignes. Par contre, dès que je souhaite traiter mon fichier de plus de 6000 lignes, après le traitement d'environ un cinquantaine de lignes, le système m'envoie le message d'erreur suivant :
Erreur 14
Espace de chaîne insuffisant
Quelle peut être la solution pour que cela fonctionne sur l'ensemble de mon fichier? D'avance merci à tous.

Scoobidoo

 

[pierrejean]

Re : Suppression de la ponctuation et de caracteres speciaux

Re
peux-tu poster ton fichier avec une 100 aine de lignes S.T.P

 

[Scoobidoo]

Re : Suppression de la ponctuation et de caracteres speciaux

Re

Merci de te pencher à nouveau sur mon problème. Voici un fichier avec les 100 premieres lignes de mon fichier. Au plaisir de te lire.

Scoobidoo

 

[pierrejean]

Re : Suppression de la ponctuation et de caracteres speciaux

Re

Le problème apparaissait ligne 45
En effet j'avais supposé qu'une parenthese ouverte etait necessairement fermée
Or ligne 45 ce n'est pas le cas
Voici donc avec modification pour traiter ce cas particulier
Esperant ne pas en avoir d'autre du même tonneau

 

[Pyrof]

Re : Suppression de la ponctuation et de caracteres speciaux

Bonjour,

Voici un autre moyen

Sub essais()
chaine1 = "TÂTÂ (a supprimer) TOTO (a détruire) +- &"
chaine2 = ""
For b = 1 To Len(chaine1)
    car = Mid(chaine1, b, 1)
    Select Case car
        Case "À", "Á", "Â", "Ã", "Ä", "Å"
            car1 = "A"
        Case "È", "É", "Ê", "Ë"
            car1 = "E"
        Case "Ì", "Í", "Î", "Ï"
            car1 = "I"
        Case "Ù", "Ú", "Û", "Ü"
            car1 = "U"
        Case "A" To "Z"
            car1 = car
        Case "("
            sup = 1
        Case ")"
            sup = 0
        Case Else
            car1 = " "
    End Select
    If sup = 0 Then chaine2 = chaine2 & car1
Next
MsgBox chaine2
End Sub

Toutes les lettres accentuées ne sont gérées dans l'exemple
Ici on peut avoir plusieurs éléments entre parenthèses
Seul petit problème c'est que ça risque d'être un peu plus long en temps de traitement que la solution de Pierrejean

 

[pierrejean]

Re : Suppression de la ponctuation et de caracteres speciaux

Re

@ Pyrof

A 1ere vue ton code ne supprime pas le texte entre parentheses (voir #1)

 

[Scoobidoo]

Re : Suppression de la ponctuation et de caracteres speciaux

Bsr Pierrejean, Pyrof, le forum,

Je te rassure tu as bel et bien raison ! Une parenthèse ouverte est généralement fermée. Mais la qualité des fichiers sur lesquels je dois travailler fait fi des règles d'orthographe de grammaire et de ponctuation d'où le travail de nettoyage à effectuer avant de tenter une quelconque exploitation des données. Par contre ton espoir qu'il n'y ait pas d'autre "coquilles" de ce style risque d'être déçu. En effet, je bug sur une ligne qui cette fois-ci à deux séries de données entre parenthèses cf :
AMAZING GRACE (REPRISE) (END TITLES)
Peux tu m'indiquer la modifications qu'il conviendrait d'apporter à ton code pour qu'il gère ce nouveau cas ? Je t'en remercie d'avance. A+

Scoobidoo

 

[homepyrof53]

Re : Suppression de la ponctuation et de caracteres speciaux

Bonsoir
Pyrof ou homepyrof53 c'est la même personne sur des sites de travail différents

Pierrejean, ma macro fonctionne bien sur ces 2 sites

chaine1= "TÂTÂ (a supprimer) TOTO (a détruire) +- &"

le résultat en chaine2 = "TATA TOTO"

bonne soirée

 

[Dull]

Re : Suppression de la ponctuation et de caracteres speciaux

Salut Scoobidoo, Pierre🙂, Pyrof, le Forum

En attendant l'ami Pierre je te met une nouvelle version de ma macro avec les remarques que tu as faites

Temps de réponse 0.90625 seconde pour 1000 éléments

Sub SansPonctuation() 'By Gruick
Dim i As Integer, C As Range, t
Const Ponctuation As String = "ÀÁÂÃÄÅÈÉÊËÌÍÎÏÙÚÛÜÑ.,:!?[]\_-&=+/""$#"
Const NoPonctuation As String = "AAAAAAEEEEIIIIUUUUN"
Dim lettre As String * 1
Range([A2], [A2].End(xlDown)).Copy Destination:=Range("D2")
Range([D2], [D2].End(xlDown)).Select
For Each C In Selection
    C = Split(Trim(C), "(")
    C = Replace(C, "*", "")
    C = Application.Trim(C)
Next C
For Each mot In Selection
  For i = 1 To Len(Ponctuation)
    lettre = Mid$(Ponctuation, i, 1)
    If InStr(mot, lettre) > 0 Then
      Nllelettre = Mid$(NoPonctuation, i, 1)
      mot.Replace what:=lettre, replacement:=Nllelettre, lookat:=xlPart
    End If
Next i
Next mot
End Sub

Certe La macro de pierrejean fait 0.5625 seconde pour le même nombre d'éléments ...ChapeauPierre🙂


Bonne Journée

 

[pierrejean]

Re : Suppression de la ponctuation et de caracteres speciaux

Re

1) mes excuses les plus plates a pyrof (je n'avais pas correctement interpreté ton code, tres astucieux, qui evite d'ajouter a partir de ( jusqu'a ))
2) Salut Dull
3) Nouvelle adaptation pour accepter des parentheses successives
4) On attend le bug suivant