Remplacement de caractères par d'autres

[cephalotus]

Bonjour le forum,

Je recherche une formule (si possible) qui me permettrait des remplacer des caractères de mon choix comme éêèôöïî,etc.. par eeeooii,etc..
Toutefois, il faut que je puisse en ajouter des caractères à remplacer par d'autres dans cette formule.

Je ne peux malheureusement pas remplacer ces caractères par la fonction remplacer d'excel, car j'ai trop de caractères à prendre en compte. De plus, c’est une tache récurrente.

Merci pour vos réponses.

 

[tototiti2008]

Re : Remplacement de caractères par d'autres

Bonjour cephalotus,

un fil qui parlait de trucs comme ça, mais avec une fonction VBA...

https://www.excel-downloads.com/threads/comment-transformer-un-e-en-e-en-vba-excel.124198/

 

[cephalotus]

Re : Remplacement de caractères par d'autres

Bonsoir tototiti2008, le forum,

Merci pour ta réponse rapide. J'ai pourtant cherché dans le forum..
J'ai une question concernant ta réponse. Si je veux ajouter un caractère (exemple ô), Comment mettre ce caractère et son remplaçant (o) dans la formule =REMPLACER(A1;CHERCHE("ë";A1;1);1;"e")

De plus, cette formule fonctionne pour le remplacement d'un seul caractère. Dans ma cellule, je peux avoir plusieurs caractères semblables à remplacer sans en connaitre le nombre.

Merci pour ta, vos réponses.

 

[SubEndSub]

Re : Remplacement de caractères par d'autres

Bonjour chez vous

En reprenant le code (de L. Longres) de la discussion citée par tototiti2008

Utiliser la macro1 pour traiter un grand volume de cellules

Private Declare Function FoldString Lib "kernel32" Alias "FoldStringA" _
    (ByVal dwMapFlags As Byte, ByVal lpSrcStr As Long, ByVal cchSrc As Long, _
        ByVal lpDestStr As Long, ByVal cchdest As Long) As Long
Function SANSACCENTS(Texte As String) As String
 Dim I As Integer
 SANSACCENTS = Space(Len(Texte))
 For I = 0 To Len(Texte) * 2 - 2 Step 2
  FoldString &H40, StrPtr(Texte) + I, 1, StrPtr(SANSACCENTS) + I, 1
 Next I
 End Function

Sub Macro1()
Dim cellules As Range, c As Range
Application.ScreenUpdating = False
Set cellules = Cells.SpecialCells(xlCellTypeConstants, 2)
For Each c In cellules
c = SANSACCENTS(c.Text)
Next
Application.ScreenUpdating = True
End Sub

 

[cephalotus]

Re : Remplacement de caractères par d'autres

Bonsoir SubEndSub, le forum,

Merci pour ta réponse rapide. Je connais quasiment que de nom le terme Macro, et cela n'a pas été très difficile de l'enregistrer.
De plus, elle fonctionne parfaitement.

Cependant, j'ai tout un "tas" d'autres caractères (comme:()',/\;!".+*:%) en plus des accents à remplacer par un caractère (trait d'union). D'autres caractères peuvent être ajoutés à cette liste par la suite, mais ils seront toujours à remplacer par le caractère trait d'union.

Comment puis-je insérer mes caractères à ta macro ?

Merci pour ta, vos réponses.

 

[SubEndSub]

Re : Remplacement de caractères par d'autres

Bonjour chez vous

Pour supprimer les accents et ne garder que les caractères alphanumériques

S'applique à la feuille active

En reprenant le code précédent et en ajoutant une autre fonction

Private Declare Function FoldString Lib "kernel32" Alias "FoldStringA" _
    (ByVal dwMapFlags As Byte, ByVal lpSrcStr As Long, ByVal cchSrc As Long, _
        ByVal lpDestStr As Long, ByVal cchdest As Long) As Long

Function SANSACCENTS(Texte As String) As String
 Dim I As Integer
 SANSACCENTS = Space(Len(Texte))
 For I = 0 To Len(Texte) * 2 - 2 Step 2
  FoldString &H40, StrPtr(Texte) + I, 1, StrPtr(SANSACCENTS) + I, 1
 Next I
 End Function

Function Alphanum(s As String) As String
With CreateObject("vbscript.regexp")
    .Global = True
    .Ignorecase = True
    .Pattern = "[^\dA-Z]"
    Alphanum = .Replace(s, "")
End With
End Function

Sub Macro1()
Dim cellules As Range, c As Range
Set cellules = Cells.SpecialCells(xlCellTypeConstants, 2)
For Each c In cellules
c.Value = SANSACCENTS(c.Text) 'supprime les accents
c.Value = Alphanum(c.Value) ' supprime les caractères non alphanumériques
Next
End Sub

 

[cephalotus]

Re : Remplacement de caractères par d'autres

Bonjour SubEndSub, le forum,

Merci pour ta réponse. La suppression des caractères non alphanumériques fonctionne très bien. Cependant, j'ai besoin d'un remplacement plutôt qu'une suppression.

En effet, j'ai besoin de remplacer ces caractères non alphanumériques par un espace par exemple.

Peut-on faire cela avec ta macro ?

Merci pour ta, vos réponses.

 

[HIJACK]

Re : Remplacement de caractères par d'autres

HI!
Tombé par hasard sur la question, fait 2 choses en ^m temps
a tout hasard

text1 = "AZERDDDDFGHJAASDFC"
text1 = Replace(text1, "A", "/")

 

[SubEndSub]

Re : Remplacement de caractères par d'autres

Il suffit de modifier ainsi

Function Alphanum(s As String) As String
With CreateObject("vbscript.regexp")
    .Global = True
    .Ignorecase = True
    .Pattern = "[^\dA-Z]"
    Alphanum = .Replace(s, [COLOR="Blue"]Chr(32)[/COLOR])
End With
End Function

 

[cephalotus]

Re : Remplacement de caractères par d'autres

Bonjour HIJACK, le forum,

Si je comprends bien, ton bout de macro remplace les "A" par "/" ?
J'ai besoin de remplacer les caractères non alphanumériques par un "espace" ou un caractère spécial qui soit différent des caractères alphanumériques.

Lorsque j'exécute la macro de SubEndSub qui fonctionne très bien (hormis de fait que je souhaite un remplacement de caractères et non et suppression), je dois appliquer après un autre traitement.

Merci pour ta, vos réponses.

 

[tototiti2008]

Re : Remplacement de caractères par d'autres

Bonjour à tous,

pour une liste de remplacement personnalisés, je te conseille d'utiliser la fnction de BrunoM45 dans le fil que je t'avais proposé. Il te suffira de personnaliser les lignes
TabAccent = ...
et
TabSans = ...

 

[SubEndSub]

Re : Remplacement de caractères par d'autres

cephalotus

Tu as essayé la version modifiée de la function Alphanum ? (celle du message de 11h16)

Les caractères non alphanumériques sont remplacés par des espaces.

Pour tester saisis en A1

&a//b##éééé puis lance la macro1

et tu obtiendras un contenu sans accents et avec des espaces à la place des caractères non alpha.

Ajout d'un fichier exemple:

Décompresses le contenu dans C:\Temp (Il faut que ce soit dans ce répertoire pour que l'exemple fonctionne )
puis double-cliques sur CréeTEST
Ensuite lances-la macro comme indiqué dans le fichier Excel

 

[HIJACK]

Re : Remplacement de caractères par d'autres

RE
Pétard je dois être borné!

Sub Macro1()
'
' Macro1 Macro
For Z = 0 To 255
Cells(Z + 1, 1) = Z
Cells(Z + 1, 2) = Chr(Z)
Next
Cells(1, 5) = Chr(208) & " " & "AERT" & " " & Chr(188) & " " & "et pourquoi pas" & " " & "o e"
TEXTE = Cells(1, 5)
Cells(1, 6) = Replace(TEXTE, Chr(208), " §  ")
Cells(1, 7) = Replace(Cells(1, 6), "pourquoi pas", "parce que")
Cells(1, 8) = Replace(Cells(1, 7), "o e", Chr(156))

'
End Sub

Si c'est juste poursupprimer des accents

Private Declare Function FoldString Lib "kernel32" Alias "FoldStringA" _
(ByVal dwMapFlags As Byte, ByVal lpSrcStr As Long, ByVal cchSrc As Long, _
ByVal lpDestStr As Long, ByVal cchdest As Long) As Long

Function PASACCENT(TEXT As String) As String
 
 Dim cont As Integer
 PASACCENT = Space(Len(TEXT))
 For cont = 0 To Len(TEXT) * 2 - 2 Step 2
  FoldString &H40, StrPtr(TEXT) + cont, 1, StrPtr(PASACCENT) + cont, 1
 Next cont
 
 End Function

Bon aller, je vais aller me suicider, ça m'occupera un moment.

Je ne vous dit pas adtaleur........

 

[cephalotus]

Re : Remplacement de caractères par d'autres

SubEndSub, HIJACK, le forum,

SubEndSub, j'ai testé la modification de ta macro en fonction de mon souhait de remplacement. Cela fonctionne à merveille. De plus, ta macro me fait tout en une seule fois. Par contre, ça met trois plombs et j'ai pourtant un PC très puissant.

HIJACK, je n'ai pas du fait pas testé ta solution, mais je te remercie tout de même de m'avoir accordé du temps pour la résolution de mon problème.

Bon week-end à tous.
Salutation

 

[SubEndSub]

Re : Remplacement de caractères par d'autres

cephalotus


Utilises cette dernière version de Macro1

Sub Macro1()
Dim cellules As Range, c As Range
Set cellules = Cells.SpecialCells(xlCellTypeConstants, 2)
Application.ScreenUpdating=False
For Each c In cellules
c.Value = SANSACCENTS(c.Text) 'supprime les accents
c.Value = Alphanum(c.Value) ' supprime les caractères non alphanumériques
Next
Application.ScreenUpdating=True
End Sub

Sur une feuille de 5000 lignes * 8 colonnes (sans formules)
(temps de traitement : un peu plus d'une minute )