Remplacer plusieurs caractères sur Excel [Fermé]

Signaler
-
Messages postés
12184
Date d'inscription
jeudi 15 mai 2008
Statut
Modérateur
Dernière intervention
31 juillet 2020
-
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 !

4 réponses

Messages postés
12184
Date d'inscription
jeudi 15 mai 2008
Statut
Modérateur
Dernière intervention
31 juillet 2020
2 477
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
Messages postés
16209
Date d'inscription
lundi 12 septembre 2005
Statut
Contributeur
Dernière intervention
17 septembre 2020
3 030
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

Messages postés
12184
Date d'inscription
jeudi 15 mai 2008
Statut
Modérateur
Dernière intervention
31 juillet 2020
2 477
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
Messages postés
16209
Date d'inscription
lundi 12 septembre 2005
Statut
Contributeur
Dernière intervention
17 septembre 2020
3 030 >
Messages postés
12184
Date d'inscription
jeudi 15 mai 2008
Statut
Modérateur
Dernière intervention
31 juillet 2020

ça roule à la montagne?

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

alors, je traine sur CCM ;o)
Messages postés
16209
Date d'inscription
lundi 12 septembre 2005
Statut
Contributeur
Dernière intervention
17 septembre 2020
3 030
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
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 ?
Messages postés
12184
Date d'inscription
jeudi 15 mai 2008
Statut
Modérateur
Dernière intervention
31 juillet 2020
2 477
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")