Enlever caractères spéciaux

Tootsi -
michel_m Messages postés 16602 Date d'inscription Statut Contributeur Dernière intervention - 7 août 2015 à 17:19

Bonjour,
mon ami Google n'a pas réussi m'aider, donc je me tourne vers vous : je devrais enlever tous les caractéres speciaux (*&^%$#@!"' ;\|?></, Ä, Â etc. sur une feuille d'excel comportant près de 10 000 lignes, et ceci plusiquers fois par semaine. Rechercher - remplacer prend trop de temps, et je ne suis pas très calée avec les macros. Quelqu'un connait-il un moyen pour le faire?

Merci beaucoup d'avance!

Cordialement,
Tootsi

Afficher la suite

A voir également:

Excel supprimer caractère spécifique
Supprimer rond bleu whatsapp - Guide
Caractère ascii - Guide
Caractère spéciaux - Guide
Liste déroulante excel - Guide
Caractere speciaux - Guide

4 réponses

Réponse 1 / 4

cs_Le Pivert Messages postés 7904 Date d'inscription Statut Contributeur Dernière intervention 729

Bonjour,

Voici un exemple avec 3 caractères spéciaux, il faudra l'adapter.
Faites une sauvegarde du classeur avant par prudence:

Option Explicit
Private Sub CommandButton1_Click()
For_X_to_Next_Colonne
End Sub
Sub For_X_to_Next_Colonne()
Dim FL1 As Worksheet, Cell As Range, NoCol As Integer
Dim NoLig As Long, DerLig As Long, Var As Variant

    'Instance de la feuille qui permet d'utiliser FL1 partout dans
    'le code à la place du nom de la feuille
    Set FL1 = Worksheets("Feuil1")
     
    'Détermine la dernière ligne renseignée de la feuille de calculs
    '(Voir explication sur l'utilisation de Split en bas de cette discussion)
    DerLig = Split(FL1.UsedRange.Address, "$")(4)
     
    'Fixe le N° de la colonne à lire
    NoCol = 1
     
    'Utilisation du N° de ligne dans une boucle For ... Next
    For NoLig = 1 To DerLig
       FL1.Cells(NoLig, NoCol).Select
    
    Caractere_speciaux
      
        'Pour tester : Affiche les variables dans la fenêtre Exécution de VBA
        Debug.Print Var
    Next
    Set FL1 = Nothing
End Sub
Sub Caractere_speciaux()
ReDim A_Remplacer(0 To 3) 'adapter au nombre de caractères
ReDim Remplacants(0 To 3) 'adapter au nombre de caractères
Dim I As Byte
On Error Resume Next
A_Remplacer = Array("%", "@", "&") 'ajouter les caractéres spéciaux
Remplacants = Array("", "", "") 'ajouter les blancs
For I = 0 To 3 'adapter au nombre de caractères
    Cells.Replace What:=A_Remplacer(I), Replacement:=Remplacants(I), LookAt:=xlPart
Next I
End Sub

Bon courage

cs_Le Pivert Messages postés 7904 Date d'inscription Statut Contributeur Dernière intervention 729

Petite erreur:

Sub Caractere_speciaux()
ReDim A_Remplacer(0 To 2) 'adapter au nombre de caractères
ReDim Remplacants(0 To 2) 'adapter au nombre de caractères
Dim I As Byte
A_Remplacer = Array("%", "@", "&") 'ajouter les caractéres spéciaux
Remplacants = Array("", "", "") 'ajouter les blancs
For I = 0 To 2 'adapter au nombre de caractères
    Cells.Replace What:=A_Remplacer(I), Replacement:=Remplacants(I), LookAt:=xlPart
Next I
End Sub

Cela commence à 0, il y a 3 caractères, cela fait :
0 To 2

Réponse 2 / 4

michel_m Messages postés 16602 Date d'inscription Statut Contributeur Dernière intervention 3 314

Bonjour,

Compte tenu du nombre de lignes important, pourrais tu préciser l'adresse du tableau pour réduire au maximum la durée de la procédure en évitant de modifier cellule par cellule

en attendant, cette fonction ne garde que les caractères
a-zA-Z0-9çàâäéèêëïîôöùû
le tiret veut dire par ex: A-Z--> comprend de A à Z

Option Explicit
'-------
Function enlever_caract_speciaux(ByRef texto As String) As String
Dim reg As Object
Dim extraction As Object
Dim digit
    Set reg = CreateObject("vbscript.regexp")
    reg.Global = True
    reg.Pattern = "([a-zA-Z0-9çàâäéèêëïîôöùû])"
    Set extraction = reg.Execute(texto)
    For Each digit In extraction
        enlever_caract_speciaux = enlever_caract_speciaux & (digit.Value)
    Next digit
    
End Function

michel_m Messages postés 16602 Date d'inscription Statut Contributeur Dernière intervention 3 314

rectification
nouveau reg.pattern
reg.pattern="([^*&'^%#@!"";\|?></,ÄÂ])"
à complèter avec la liste complète des exclus (sans espace!)

Toujours en attente de précisions sur le tableau.... :-/

Réponse 3 / 4

Tootsi

Bonjour,
Merci beaucoup de votre aide cs_Le Pivert et michel_m!

J'ai commencé tester avec le code donné par cs_Le Pivert, car malheureusement, je n'avais pas compris ce que Michel tu voulais dire par l'adresse du tableau (pardon, suis pas française :) ). Mais c'est peut-être l'endroit où est situé le fichier sur l'ordi?

Merci beaucoup de prendre votre temps pour m'aider!

Tootsi

michel_m Messages postés 16602 Date d'inscription Statut Contributeur Dernière intervention 3 314

exemple d'adresse
"feuil1.A2: G7000"
cellule en haut et à gauche: A2
cellule en bas et à droite: G7000

on peut renre dynamique en calculant la dernière ligne par une instruction dans le gente de Derlig donné par csPivert( que je salue)

Tootsi > michel_m Messages postés 16602 Date d'inscription Statut Contributeur Dernière intervention

Ah, je comprends mieux :) : A1 - AE9637

michel_m Messages postés 16602 Date d'inscription Statut Contributeur Dernière intervention 3 314

je te proposerai un code cet aprem

dernière question importante:
dans quelle(s) colonne(s) faut il supprimer ces caractères ?

publicité:
depuis le temps que tu fréquentes le site CCm, pourquoi ne t'inscris tu pas (c'est gratuit)

Tootsi > michel_m Messages postés 16602 Date d'inscription Statut Contributeur Dernière intervention

Les caractères sont à enlever dans les colonnes E, F, W et X.

Et en fait je pense que je suis inscrit :), mais comme je suis au travail, je n'ai pas réussi trouver le mot de passe.

Merci encore!!

michel_m Messages postés 16602 Date d'inscription Statut Contributeur Dernière intervention 3 314 > Tootsi

vu la canicule dans mon coin (37°), programmer me fait rester au frais (ou presque) :o)

ci joint propoisition sur 2500 lignes; durée >= 2 secondes
http://www.cjoint.com/c/EHhnZQOyunE

et le code

Option Explicit
'-----------------------------------
Sub supprimer()
Dim Derlig As Integer, Tablo
Dim start As Single

    Application.ScreenUpdating = False 'fige l'écran: confort et rapidité
    start = Timer

    With Sheets(2) 'A ADAPTER
        'colonnes EF
        Derlig = .Columns("E").Find(what:="*", searchdirection:=xlPrevious).Row
        Tablo = .Range("E1:F" & Derlig) 'mémorisation en Ram
        nettoyer Tablo 'appel macro paramétrée
        .Range("E1:E" & Derlig) = Tablo 'restitution tableau nettoyé
        'colonnes WX
        Derlig = .Columns("W").Find(what:="*", searchdirection:=xlPrevious).Row
        Tablo = .Range("W1:X" & Derlig)
        nettoyer Tablo
        .Range("W1:X" & Derlig) = Tablo
        
       Application.ScreenUpdating = True
       MsgBox ("suppression des caractères spéciaux en : " & Timer - start & " sec.")
   End With
End Sub
'---------------------------------------------------------

Sub nettoyer(Tablo)
Dim Cptr As Integer, Texto As String
For Cptr = 1 To UBound(Tablo)
    Texto = Tablo(Cptr, 1)
    Tablo(Cptr, 1) = enlever_caract_speciaux(Texto)
    Texto = Tablo(Cptr, 2)
    Tablo(Cptr, 2) = enlever_caract_speciaux(Texto)
Next
End Sub
'------------------------------------------------------------

Function enlever_caract_speciaux(ByRef Texto As String) As String
Dim Reg As Object
Dim Extraction As Object
Dim Digit

    Set Reg = CreateObject("vbscript.regexp")
    Reg.Global = True
    Reg.Pattern = "([^*&'^%#@!"";|?></\,ÄÂ])" ' A COMPLETER
    Set Extraction = Reg.Execute(Texto)
    For Each Digit In Extraction
        enlever_caract_speciaux = enlever_caract_speciaux & (Digit.Value)
    Next Digit
End Function

Discussions similaires

Formule pour d'enlever des caracteres dans une cellule...

Sisnes superieur ou egale et inferieur ou egale

ajout même texte dans plusieurs cellules

Saisie des symboles à l'aide du clavier

Enlever 2 caractères à droite d'une cellule

Supprimer des caractères dans une cellule excel

Votre réponse

Discussions similaires