Microsoft 365 Fond de couleur

[Harry13]

Bonjour à tous

J'essaye d'identifier mon erreur sur cette macro mais en vain.
En effet, je souhaite mettre un fond de couleur les cellules non vide de la colonne A, les valeurs identiques de la même couleur et les cellules vide rien

Existe-il quelqu'un pour m'aider à rectifier le tire svp ?

Sub MiseEnCouleur()
    Dim fin&, coul&, i&, d As Object, aa, bb, a&
    Set d = CreateObject("Scripting.Dictionary")
    coul = 4
    With Worksheets("Feuil1")
        fin = .Range("A" & Rows.Count).End(xlUp).Row
        aa = .Range("A5:A197")
        For i = 1 To UBound(aa)
            If aa(i, 1) <> "" And Not d.exists(aa(i, 1)) Then d.Add aa(i, 1), aa(i, 1)
        Next i
        bb = d.keys
        For i = 0 To UBound(bb)
            coul = coul + 1
            For a = 1 To UBound(aa)
                If bb(i) = aa(a, 1) Then .Cells(a + 1, 1).Interior.ColorIndex = coul
            Next a
        Next i
    End With
End Sub

J'ai mis en PJ un fichier illustrant ce que je veux sur le deuxième onglet (Résultat souhaité). (Ne faite pas attention aux couleurs cela se fait aléatoirement)
La macro se fait sur l'onglet Feuil1

Je vous remercie de votre aide précieuse

Harry

 

[sylvanu]

Bonjour Harry,
Votre pointeur "a" commence à 1 pour le tableau mais doit commencer à 5 pour les cellules.

If bb(i) = aa(a, 1) Then .Cells(a + 4, 1).Interior.ColorIndex = coul

D'autre part ColorIndex va de 1 à 56, si vous avez plus de 56 cellules à appliquer vous aurez une erreur, il vous faudra faire un modulo.

 

[Harry13]

Bonjour Sylvanu,

Je comprends. Je pense que je n'aurai pas plus de 56 cellules à remplir.
C'est parfait et fonctionne comme je l'entends. Merci

Harry