XL 2016 Colorier chaque lettre d'une couleur différente

Sub couleurs()
Dim i&, j&
Randomize 1600
With Application
.ScreenUpdating = False
Columns(2).Value = Columns(1).Value 'au cas où pas de valeurs en colonne B
For i = 1 To Cells(Rows.Count, 2).End(3).Row
For j = 1 To Len(Cells(i, 2))
Cells(i, 2).Characters(j, 1).Font.Color = RGB(.RandBetween(1, 255), .RandBetween(1, 255), .RandBetween(1, 255))
Next
Next
End With
End Sub

Sub Couleurs_II()
Dim i&, j&
Application.ScreenUpdating = False
For i = 1 To Cells(Rows.Count, 2).End(3).Row
  For j = 1 To Len(Cells(i, 2))
    Select Case Asc(Cells(i, 2).Characters(j, 1).Text)
    Case 48 To 57
    Cells(i, 2).Characters(j, 1).Font.Color = vbYellow 'Nombre
    Case 65 To 90
    Cells(i, 2).Characters(j, 1).Font.Color = vbRed 'Majuscule
    Case 97 To 127
    Cells(i, 2).Characters(j, 1).Font.Color = vbGreen 'Minuscule
    End Select
  Next
Next
End Sub

Sub Couleurs()
Dim d As Object, c As Range, i%, coul
Set d = CreateObject("Scripting.Dictionary")
Randomize
With Application
    .ScreenUpdating = False
    For Each c In [A1].CurrentRegion
        For i = 1 To Len(c)
            If Mid(c, i, 1) = " " Then d.RemoveAll: i = i + 1 'nouveau mot
            Do
                coul = .RandBetween(3, 56) 'palette des 56 couleurs
                If Not d.exists(coul) Then Exit Do
            Loop
            d(coul) = ""
            c.Characters(i, 1).Font.ColorIndex = coul
    Next i, c
End With
End Sub

Sub RAZ()
[A1].CurrentRegion.Font.ColorIndex = xlAutomatic
End Sub

Sub PourTest()
Application.ScreenUpdating = False
[A1:A3].Value = Application.Transpose(Array(123, "ABC", "Excel Downloads"))
Range("A1:A3").AutoFill Destination:=Range("A1:A10000"), Type:=xlFillCopy
End Sub