Private Sub Worksheet_Change(ByVal Target As Range)
Dim chiffre$, lettre$, d As Object, i%, x$, a$, b$, L%
chiffre = [A2].Text
lettre = [A3].Text
Set d = CreateObject("Scripting.Dictionary")
Application.EnableEvents = False 'désactive les évènements
'---traitement de A2 et A3---
For i = 1 To Len(chiffre)
x = Mid(chiffre, i, 1)
If IsNumeric(x) And Not d.exists(x) Then d(x) = "": a = a & x
Next
For i = 1 To Len(lettre)
x = Mid(lettre, i, 1)
If Not IsNumeric(x) And Not d.exists(x) Then d(x) = "": b = b & x
Next
chiffre = a: lettre = b
[A2] = chiffre: [A3] = lettre
L = IIf(Len(a) < Len(b), Len(a), Len(b)) 'plus petite longueur des 2 textes
'---traitement de B2 et B3---
d.RemoveAll
For i = 1 To L
d(Mid(chiffre, i, 1)) = Mid(lettre, i, 1)
Next
a = [B2].Text: b = ""
For i = Len(a) To 1 Step -1
x = Mid(a, i, 1)
If d.exists(x) Then
b = d(x) & b
Else
a = Left(a, i - 1) & Mid(a, i + 1)
End If
Next
[B2] = a: [B3] = b
'---traitement de C2 et C3---
d.RemoveAll
For i = 1 To L
d(Mid(lettre, i, 1)) = Mid(chiffre, i, 1)
Next
a = [C2].Text: b = ""
For i = Len(a) To 1 Step -1
x = Mid(a, i, 1)
If d.exists(x) Then
b = d(x) & b
Else
a = Left(a, i - 1) & Mid(a, i + 1)
End If
Next
[C2] = a: [C3] = b
Application.EnableEvents = True
Columns("A:C").AutoFit 'ajustement largeur
End Sub