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

[dindin]

Bonjour
J'ai 5000 mots dans la colonne A . Je voulu dans la colonne B les copier en coloriant chaque lettre d'une couleur différente de la lettre précédente.
Ex: maison m en bleu a en rouge i en vert ..... etc
Les mots varient de 2 à 15 lettres chacune.
Pouvez-vous m'aider svp. Merci.

 

[Staple1600]

Bonjour le fil, dindin

dindin
Une possible façon de faire

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

EDITION: Bonjour Robert

 

[Robert]

Bonjour Dindin, bonjour le forum,

Essaie comme ça :

Sub Macro1()
Dim O As Worksheet 'déclare la varaible O (Onglet)
Dim DL As Integer 'déclare la varaible DL (Dernière Ligne)
Dim I As Integer 'déclare la varaible I (Incrément)
Dim C As Byte 'déclare la variable C (Couleur)
Dim J As Integer 'déclare la varaible J (incrément)
Dim TC() 'déclare la varaible TC (Tableau des Couleurs)
Dim K As Integer 'déclare la varaible K (incrément)

Set O = Worksheets("Feuil1") 'définit l'onglet O (à adapter à ton cas)
DL = O.Cells(Application.Rows.Count, "A").End(xlUp).Row 'définit la dernière ligne éditée DL de la colonne A de l'onglet O
Randomize 'lance le générateur de nombres aléatoires
For I = 1 To DL 'boucle 1 : sur toutes les lignes I de 1 à DL
    C = 0 'initialise la couleur C
    For J = 1 To Len(O.Cells(I, "A")) 'boucle 2 : sur tous les caractères de la cellule ligne I colonne A de l'onglet O
        ReDim TC(3 To 56 - (J - 1)) 'redimensionne le tableau des couleurs TC (diminue de 1 à chaque boucle 2)
        For K = 3 To 56 - (J - 1) 'boucle 3 : sur toutes les couleurs ColorIndex K de 3 à [56-(j-1)]
            If Not K = C Then TC(K) = I 'alimente le tableau des couleurs sauf la couleur C
        Next K 'prochaine couleur de la boucle 3
        C = Int((UBound(TC) - 2) * Rnd + 3) 'définit la couleur C de manière aléatoire
        O.Cells(I, "A").Characters(Start:=J, Length:=1).Font.ColorIndex = C 'colore le caractère de la boucle 2 avec la couleur C
    Next J 'prochain caractère de la boucle 2
Next I 'prochaine ligne de la boucle 1
End Sub

[Édition]
Pfff !... Évidement, si l'agrafe (que je salue au passage) passe avant moi j'ai l'air d'un c** !...

 

[Staple1600]

Bonjour à toi aussi Robert

(cf message#2)

 

[Robert]

Re,

Nos post se sont croisés l'Agrafe... C'est pour cela que je ne t'ai pas salué. Ce fut fait dans l'édition de mon premeir post...

 

[Staple1600]

Re

Robert
Est-ce que comme moi, tu cherches encore la finalité de la chose ?
Surtout sur 5000 lignes !
Bonjour les migraines ophtalmiques

 

[youky(BJ)]

Est-ce un Excel dédié à la fête des lumières de Lyon qui a lieu dans quelques jours ?
Le tout haut en couleurs . . .
Bonjour à tous, Bruno Hihi!

 

[Staple1600]

Bonsoir youky(BJ)

Très jolie fête en effet

Une autre macro (pour réduire les couleurs et donc les céphalées)

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

 

[dindin]

Merci à tous . Je regarde ce soir et vous tiens au courant

 

[job75]

Bonsoir dindin, JM, Robert, Bruno,

J'ai testé la macro de JM.

Dès que le nombre de caractères dépasse 1000 environ on a un message d'erreur : "Nombre maximum de polices de caractères autorisées atteint."

A+

 

[Staple1600]

Re

job75
Cela me rassure.
Excel se rebiffe car tout comme moi, il ne comprends pas la finalité de la chose, ni comment un être humain a plaisir à lire des mots ainsi formatés.
NB: J'avais testé sur un cinquantaine de lignes avec juste deux trois mots par cellules

PS: Le demandeur indique que le max de caractères sera de 15 (cf message#1)
Donc en théorie, son Excel ne bronchera pas (hélas)

 

[job75]

Voyez le fichier joint et ces macros, la palette des 56 couleurs est utilisée :

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

Dans un même mot les caractères ont des couleurs différentes.

Edit : j'ai recopié le tableau 20 fois pour obtenir 5580 mots, cela fonctionne mais il arrive que la mémoire soit insuffisante.

 

[Staple1600]

Bonsoir le fil

job75
J'ai testé ta macro
(Une colonne A remplie avec cette macro au préalable)

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

Et où on s'aperçoit que Microsoft n'oublie pas son sens du commerce

EDITION: Message posté sans avoir lu ton édition.

 

[job75]

Oui JM, j'ai Excel 2019 64 bits et il arrive comme je l'ai dit que la mémoire soit insuffisante.

Bonne nuit.

 

[Staple1600]

Re

=>job75
J'ai précisé que j'ai fait le test avant l'édition de ton message
(Cf édition du mon précédent message)

=> le fil
Ce qui me questionne le plus dans cette histoire de couleurs, c'est pas que nos codes respectifs puissent plantouiller.
C'est quel est le but visé par dindin ?
Car j'ai du mal à voir quel contexte justifie cette "débauche" de couleurs.