Enlever caractères spéciaux [Fermé]

- - Dernière réponse : michel_m
Messages postés
15938
Date d'inscription
lundi 12 septembre 2005
Statut
Contributeur
Dernière intervention
21 octobre 2019
- 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 

4 réponses

Messages postés
6290
Date d'inscription
jeudi 13 septembre 2007
Statut
Contributeur
Dernière intervention
21 octobre 2019
400
0
Merci
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
6290
Date d'inscription
jeudi 13 septembre 2007
Statut
Contributeur
Dernière intervention
21 octobre 2019
400 -
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
Messages postés
15938
Date d'inscription
lundi 12 septembre 2005
Statut
Contributeur
Dernière intervention
21 octobre 2019
2813
0
Merci
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
15938
Date d'inscription
lundi 12 septembre 2005
Statut
Contributeur
Dernière intervention
21 octobre 2019
2813 -
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.... :-/
0
Merci
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
15938
Date d'inscription
lundi 12 septembre 2005
Statut
Contributeur
Dernière intervention
21 octobre 2019
-
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
15938
Date d'inscription
lundi 12 septembre 2005
Statut
Contributeur
Dernière intervention
21 octobre 2019
2813 > 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
> michel_m
Messages postés
15938
Date d'inscription
lundi 12 septembre 2005
Statut
Contributeur
Dernière intervention
21 octobre 2019
-
Chouette, merci beaucoup! Avec des boutons et tout, je suis épatée! Je vais tester ça lundi, mais au moins ton ficher test marche, donc il n'y a pas de raison. Je vais donc marquer mon problème résolu.

Merci encore et bon courage dans une telle chaleur!! Sur la région parisienne c'est plus supportable :)
cs_Le Pivert
Messages postés
6290
Date d'inscription
jeudi 13 septembre 2007
Statut
Contributeur
Dernière intervention
21 octobre 2019
400 > michel_m
Messages postés
15938
Date d'inscription
lundi 12 septembre 2005
Statut
Contributeur
Dernière intervention
21 octobre 2019
-
michel_m,

très bien, juste une petite rectification à la ligne:

.Range("E1:E" & Derlig) = Tablo 'restitution tableau nettoyé


remplacer par

.Range("E1:F" & Derlig) = Tablo 'restitution tableau nettoyé


la colonne F n'était pas parcouru!

classeur à conserver

Avec ma méthode les * et ? ne passaient pas!

Ils effaçaient tout

Cordialement
michel_m
Messages postés
15938
Date d'inscription
lundi 12 septembre 2005
Statut
Contributeur
Dernière intervention
21 octobre 2019
2813 > cs_Le Pivert
Messages postés
6290
Date d'inscription
jeudi 13 septembre 2007
Statut
Contributeur
Dernière intervention
21 octobre 2019
-
OK, merci ;o)
Bon WE
Messages postés
6290
Date d'inscription
jeudi 13 septembre 2007
Statut
Contributeur
Dernière intervention
21 octobre 2019
400
0
Merci
Tu peux supprimer cette ligne dans Sub For_X_to_Next_Colonne()
cela sera plus rapide:

  FL1.Cells(NoLig, NoCol).Select

Merci beaucoup cs_Le Pivert ! J'ai réussi faire fonctionner ton code, ah, c'est super!!!!