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.

 

[dindin]

Bonjour tout le monde
Je prépare des cours d'apprentissage de l'alphabet arabe.
Mon but c'est colorier la lettre de chaque mot vu que chaque lettre change de forme suivant sa position dans le mot.
- les couleurs aident beaucoup les enfants à mémoriser les différentes formes de chaque lettre.
En plus une présentation avec les couleurs est mieux suivie par des enfants de CP.
Après essai de différents code je me trouve avec des mots découpés.
Après réflexion, le problème vient de la spécificité de la langue elle-même.
Chaque lettre possède une voyelle.
Excel considère que chaque lettre avec sa voyelle vaut 2 caractères et non pas un seul.
Je vais essayer de modifier le code pour qu'il me donne le résultat voulu.
Merci à tous pour votre aide .
Je vous joint un exemple dans la matinée.

 

[job75]

Bonjour dindin, le forum,

Pour éviter le message "mémoire insuffisante" il suffit d'utiliser DisplayAlerts :

Sub Couleurs()
Dim d As Object, c As Range, i%, coul
Set d = CreateObject("Scripting.Dictionary")
Randomize
With Application
    .ScreenUpdating = False
    .DisplayAlerts = 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
            Loop While d.exists(coul)
            d(coul) = ""
            c.Characters(i, 1).Font.ColorIndex = coul
    Next i, c
End With
End Sub

Fichier (2) avec 5580 mots.

Bonne journée.

 

[job75]

De votre post #16 je comprends que vous voulez qu'une voyelle ait la même couleur que la lettre qui la précède alors voyez ce fichier (3) :

Sub Couleurs()
Dim voyelle$, d As Object, c As Range, i%, flag As Boolean, coul
voyelle = "AEIOUY"
Set d = CreateObject("Scripting.Dictionary")
Randomize
With Application
    .ScreenUpdating = False
    .DisplayAlerts = 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
            flag = True
            If InStr(voyelle, UCase(Mid(c, i, 1))) Then If i > 1 Then If Mid(c, i - 1, 1) <> " " Then flag = False
            If flag Then
                Do
                    coul = .RandBetween(3, 56) 'palette des 56 couleurs
                Loop While d.exists(coul)
                d(coul) = ""
            End If
            c.Characters(i, 1).Font.ColorIndex = coul
    Next i, c
End With
End Sub

 

[dindin]

je regarde merci beaucoup à vous tous

 

[Staple1600]

Bonjour le fil

=>dindin
Merci d'avoir précisé le contexte d'utilisation et le but visé.

 

[job75]

Dans ce fichier (4) le texte est en arabe avec 5400 mots.

Pour les voyelles jai supposé qu'il s'agit des 3 voyelles longues, je les ai mises en cellule H1.

La notion de majuscule/minuscule n'existant pas j'ai supprimé le UCase.

 

[dindin]

un travail très bien soigné.
Excellent
pour info voilà les voyelles de l'arabe : َ ً ُ ٌ ّ ْ ِ ٍ ِّ ُّ َّ
Pour les voyelles longues je cherche une nouvelle idée qui pourra aider à mieux présenter mes cours surtout que j'utilise la méthode syllabique.
Car les chaque voyelle longue fait partie d'une syllabe.
je reviendrai vers vous quand l'idée sera bien dessinée dans ma tête.
Pour le moment votre travail est plus que Formidable.
ça fait plus d'un an que je travaille sur ce grand projet.

 

[dindin]

j'ai oublié de préciser que mon dernier message est adressé à job75
sans oublier le travail de staple1600 qui a bien fonctionné aussi. Merci à vous aussi.

 

[Staple1600]

Re

dindin
Merci pour le feedback.
Ça fait plaisir


PS: N'oublie pas Robert qui est passé au début du fil

 

[dindin]

Un grand merci à Robert aussi .
C'était un oubli de ma part.
Merci à vous tous.