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