Remplacer plusieurs caractères sur Excel

Fermé

Caractère

VbaNoob - 21 oct. 2015 à 11:14
pijaku Messages postés 12263 Date d'inscription jeudi 15 mai 2008 Statut Modérateur Dernière intervention 4 janvier 2024 - 26 oct. 2015 à 09:30

Bonjour,

J'ai farfouillé le site ainsi que d'autres mais je ne trouve pas ce que je souhaite, à savoir :
Une macro permettant de changer plusieurs caractères dans un texte sans changer les caractères initiaux par leurs changements.

Pour faire plus clair ( :)) :
"bonjour" -> "lngknea"
b : l
o : n
n : g
j : k
o : n
u : e
r : a
Et non :
"bonjour" -> "lggkgea" : comme le "o" devient "n", la macro change le "n" en "g", donc ça fait "gg" au lieu de "ng".

J'avais pris la macro suivante :

Sub remplacerCaracteres()
Dim Cell As Variant

For Each Cell In Selection
Cell.Value = Replace(Cell.Value, "b", "l")
Next Cell
End Sub

Et j'avais ajouté à la suite les lignes correspondantes à chaque lettre :

Sub remplacerCaracteres()
Dim Cell As Variant

For Each Cell In Selection
Cell.Value = Replace(Cell.Value, "b", "l")
Cell.Value = Replace(Cell.Value, "o", "n")
Cell.Value = Replace(Cell.Value, "n", "g")
Cell.Value = Replace(Cell.Value, "j", "k")
Cell.Value = Replace(Cell.Value, "u", "e")
Cell.Value = Replace(Cell.Value, "r", "a")

Next Cell
End Sub

Et du coup ça me remplaçait tout, y compris les caractères déjà changés.

J'ai essayé de modifier en mettant :
Cell.Value = Replace(Replace(Cell.Value, "b", "l"),"o", "n")
Etc
Mais ça ne fonctionne pas.

Quelqu'un saurait-il m'aider ?

Merci !

A voir également:

Excel substitue plusieurs caractères
Liste déroulante excel - Guide
Caractères ascii - Guide
Caractères spéciaux symboles clavier - Guide
Formule excel - Guide
Formule excel pour additionner plusieurs cellules - Guide

4 réponses

Réponse 1 / 4

pijaku Messages postés 12263 Date d'inscription jeudi 15 mai 2008 Statut Modérateur Dernière intervention 4 janvier 2024 2 743
Modifié par pijaku le 21/10/2015 à 11:59

Bonjour,

Essaie ceci :

Option Explicit

Dim Lettres(), A_Remplacer_Par()

Sub Main()
Dim mot As String, mot_crypte As String
   Lettres = Array("b", "o", "n", "j", "u", "r")
   A_Remplacer_Par = Array("l", "n", "g", "k", "e", "a")
   mot = "bonjour"
   mot_crypte = Crypte(mot)
   MsgBox mot_crypte
End Sub

Function Crypte(mot As String) As String
Dim i As Integer, temp As String
   temp = ""
   For i = 1 To Len(mot)
      temp = temp & A_Remplacer_Par(Application.Match(Mid(mot, i, 1), Lettres, 0) - 1)
   Next i
   Crypte = temp
End Function

Les variables tableaux Lettres et A_Remplacer_Par sont à compléter.

EDIT :
En "prime", une fonction pour "décrypter" :

Function Decrypte(mot As String) As String
Dim i As Integer, temp As String
   temp = ""
   For i = 1 To Len(mot)
      temp = temp & Lettres(Application.Match(Mid(mot, i, 1), A_Remplacer_Par, 0) - 1)
   Next i
   Decrypte = temp
End Function

Avant, j'arrivais jamais à finir mes phrases... mais maintenant je

Réponse 2 / 4

michel_m Messages postés 16603 Date d'inscription lundi 12 septembre 2005 Statut Contributeur Dernière intervention 16 décembre 2023 3 303
21 oct. 2015 à 13:59

Bonjour Vbanoob
Salut Frank, ca va ?

une autre méthode

Option Explicit
Option Base 1
'-------------------------
Sub test()
coder "B2"
End Sub
'-------------------------------------
Sub coder(Adresse)
Dim T_Adresse, T_code, Dico As Object
Dim cptr As Byte, texto As String, Taille As Byte, Lettre As String * 1

Set Dico = CreateObject("scripting.dictionary")
T_Adresse = Array("b", "j", "n", "o", "r", "u")
T_code = Array("l", "k", "g", "n", "a", "e")
For cptr = 1 To UBound(T_Adresse)
    Dico.Add T_Adresse(cptr), T_code(cptr)
Next

Taille = Len(Range(Adresse))
For cptr = 1 To Taille
    Lettre = Dico.Item(Mid(Range(Adresse), cptr, 1))
    texto = texto & Lettre
Next
Range(Adresse) = texto
End Sub

'-------------------------------------
Sub test()
coder "B2"
End Sub

pijaku Messages postés 12263 Date d'inscription jeudi 15 mai 2008 Statut Modérateur Dernière intervention 4 janvier 2024 2 743
21 oct. 2015 à 14:28

Salut Michel,

Tout va bien, merci.
Et toi? ça roule à la montagne??

Jolie méthode.
Attention toutefois à ne pas mettre deux fois la Sub test ;-))

Bonne journée

michel_m Messages postés 16603 Date d'inscription lundi 12 septembre 2005 Statut Contributeur Dernière intervention 16 décembre 2023 3 303 > pijaku Messages postés 12263 Date d'inscription jeudi 15 mai 2008 Statut Modérateur Dernière intervention 4 janvier 2024
21 oct. 2015 à 15:14

ça roule à la montagne?

bof ! il y a un P..... de Mistral !

alors, je traine sur CCM ;o)

Réponse 3 / 4

michel_m Messages postés 16603 Date d'inscription lundi 12 septembre 2005 Statut Contributeur Dernière intervention 16 décembre 2023 3 303
21 oct. 2015 à 14:35

Pour le fun, une méthode de cryptage sur toutes les lettres et chiffres
le changement du numéro de la clé (ici 2345) modifie le texte crypté

Option Explicit

Private Sub Worksheet_SelectionChange(ByVal Target As Range)
' A partir d'un exemple fourgonné sur la toile.

Dim base As Integer, cptr As Integer
Dim clé As String
Dim lettre As String * 1
'Dim base_r as Integer

If Intersect(Target, Range("B2")) Is Nothing Then: End
If Target.Value = "" Then: End
'nom = Target.Value

' transformation de l'identité en somme des valeurs des codes ascii
For cptr = 1 To Len(Target.Value)
   lettre = Mid(Target.Value, cptr, 1)
    base = base + Asc(lettre)
Next

' Xor: exclusion réciproque (sur les bits): base classique du criptage
' "clé" pour débogage espion peut être supprimée
'clé = Abs(base Xor 2345)
' test de symetrie Xor pour comprendre base-r doit être égal à base
'base_r = Abs(clé Xor 2345)
'clé = clé + base

Range("B2") = précode & Abs(base Xor 2345) + base


End Sub

Réponse 4 / 4

VbaNoob
21 oct. 2015 à 15:09

Bonjour et merci pour vos réponses,

J'ai essayé les différentes méthodes proposées et à l'heure actuelle je ne suis parvenu qu'à faire fonctionner celle de Pikaju.

Cependant, j'ai un texte complet à convertir et il me semble que cette solution ne fonctionne que pour le mot paramétré initialement.

Par conséquent, si je crée deux colonnes :
- 1 : lettres, chiffres, signes de ponctuation
- 2 : équivalences
Est-ce que je peux obtenir un résultat pour l'ensemble des mots présents dans ces colonnes sans msgbox ?

pijaku Messages postés 12263 Date d'inscription jeudi 15 mai 2008 Statut Modérateur Dernière intervention 4 janvier 2024 2 743
26 oct. 2015 à 09:30

Bonjour,

Excuse, je n'ai pas vu cette question.

Pour "crypter" et/ou "décrypter" de plus longs messages, il suffit de placer les caractères (lettres, chiffres, ponctuation...) dans :

   Lettres = Array("b", "o", "n", "j", "u", "r")

et leurs équivalences, dans l'ordre, dans :

   A_Remplacer_Par = Array("l", "n", "g", "k", "e", "a")

Discussions similaires

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

Fonction SI, contient une chaine de caractère

Formule Excel : "SI" une cellule contient un mot, alors ?

Excel: Si contient *partie texte1* OU *partie de texte2 alors...

INDIRECT, SUBSTITUE et apostrophes

Aide pour inverser une chaîne de caractère en C

Discussions similaires

Newsletters