Changement de couleur cellule automatique selon l'historique de la colonne

Bonjour à tous,

Dans un fichier de saisi, je cherche à avoir un code vba permettant de mettre en couleur une cellule (Ex: H5=BABA) d'une couleur random automatiquement à l'ajout d'une nouvelle valeur/ligne, pour conditions :

• Si le résultat est déjà présent dans la même colonne (en gros de H1:H4), mettre de la même couleur que la cellule en question historiquement. (Ex : Si H1 = BABA, et que la colonne est en bleu, H5 sera aussi en bleu)
• Si non attribuer une nouvelle couleur (random) à cette valeur.

Ce code s'appliquerai à chaque changement dans la colonne H (de type Private Sub Worksheet_Change(ByVal T As Range))

Ma difficulté ici est de devoir comparer la nouvelle cellule ajoutée à l'historique précédemment.

Autre détail : dans le fichier si joint il y a peu de valeur différentes, mais dans le vrai il y aura des centaines de valeurs différentes à termes (je travaille sur des milliers de lignes).

Merci pour votre aide !

Salut guarnaud,

le problème n'est pas de trouver et composer une autre couleur mais :

- de manière immédiate, perso évidemment, je ne vois pas comment, sauf usine à gaz, composer une couleur suffisamment contrastée par rapport aux autres.

Teste, sur la feuille2, en sélectionnant des Range à la volée, ce que peut donner une suite de couleurs aléatoires ;

- en lisant entre les lignes de certains commentaires glanés ci et là, il semblerait qu'Excel ne supporterait qu'un certain nombre (lequel?) de cellules mises en forme. A vérifier!

Private Sub Worksheet_SelectionChange(ByVal Target As Range)
'
Dim rCel As Range
Dim xRed%, xGreen%, xBlue%
'
Cells.Delete
On Error Resume Next
For Each rCel In Selection
    Randomize
    xRed = Application.WorksheetFunction.RandBetween(0, 255)
    xGreen = Application.WorksheetFunction.RandBetween(0, 255)
    xBlue = Application.WorksheetFunction.RandBetween(0, 255)
    rCel.Interior.Color = RGB(xRed, xGreen, xBlue)
Next
'
End Sub

On continue ainsi ?

Et si oui, c'est bien uniquement les cellules de la colonne [H:H] qui sont concernées ?

A+

Salut à toi et merci pour la réponse !

Je t'avoue que la vois que maintenant et que j'ai réussi à faire un petit truc.

Il manque plus que je fasse une boucle

Private Sub Worksheet_Change(ByVal T As Range) 'Sub couleurs() der_ligne = Cells.SpecialCells(xlCellTypeLastCell).Row der_ligne_2 = Worksheets("couleurs").Cells.SpecialCells(xlCellTypeLastCell).Row nom = Cells(der_ligne, 1) recherche_couleur = Application.VLookup(nom, Sheets("couleurs").Range("A1:B" & der_ligne_2), 2, False) recherche_couleur = CStr(recherche_couleur) If recherche_couleur = "Erreur 2042" Then Worksheets("couleurs").Cells(der_ligne_2 + 1, 1) = nom Randomize nouvelle_couleur = RGB(Int(256 * Rnd), Int(256 * Rnd), Int(256 * Rnd)) Worksheets("couleurs").Cells(der_ligne_2 + 1, 2) = nouvelle_couleur Cells(der_ligne, 1).Interior.Color = nouvelle_couleur Else Cells(der_ligne, 1).Interior.Color = recherche_couleur End If End Sub