Microsoft 365 [Résolu] Couleurs doublons multiple

[Neo37]

Bonjour à tous,

Je souhaiterais mettre en évidence des valeurs identiques (nombre ou texte) dans une plage de cellule.
Une mise en forme conditionnelle simple des doublons, Excel le propose nativement dans ses exemples, mais je voudrais qu'il y est des couleurs différentes selon les valeurs.
Et des couleurs bien différentes, pas une variation de nuance.
De plus, sans connaître les valeurs à l'avance, c'est là que ça se corse pour mon niveau sur Excel.
Mes valeurs sont même obtenues par formules, je ne sais pas si cela pose un réel soucis supplémentaire.

J'ai essayé de questionner ChatGPT, mais j'ai fait choux blanc.
La formule proposée ne fonctionne pas chez moi (ici un exemple pour des données de A1 à A10).
En dupliquant les MFC pour autant de couleur possible/voulu.
=MOD(SOMMEPROD(--($A$1:$A$10=A1);1/COUNTIF($A$1:$A$10;$A$1:$A$10));2)=0

Aucune réaction d'Excel, mes cellules restent incolores.

 

[patricktoulon]

bonsoir
avec couleur différentes tu va devoir passer par une fonction vba

 

[job75]

Bonjour Neo37, Patrick, le forum,

Voyez le fichier .xlsm joint et cette macro dans le code de la feuille :

Private Sub Worksheet_Change(ByVal Target As Range)
Dim coulfond, coulpolice, ncoul%, d As Object, P As Range, c As Range, x$, n%, nn%
coulfond = Array(vbBlack, vbRed, vbGreen, vbYellow, vbBlue, vbMagenta, vbCyan) 'à adapter
coulpolice = Array(vbWhite, vbWhite, vbBlack, vbBlack, vbWhite, vbBlack, vbBlack) 'à adapter
ncoul = UBound(coulfond) + 1
Set d = CreateObject("Scripting.Dictionary")
d.CompareMode = vbTextCompare 'la casse est ignorée
Set P = UsedRange
Application.ScreenUpdating = False
P.Interior.ColorIndex = xlNone 'RAZ
P.Font.ColorIndex = xlAutomatic 'RAZ
For Each c In P
    If c <> "" Then
        x = CStr(c)
        If Not d.exists(x) Then If Application.CountIf(P, c) > 1 Then n = n + 1: d(x) = n
        nn = d(x)
        If nn > 0 And nn <= ncoul Then
            c.Interior.Color = coulfond(nn - 1)
            c.Font.Color = coulpolice(nn - 1)
        End If
    End If
Next
End Sub

Elle se déclenche quand on modifie ou valide une cellule quelconque.

Ici on se limite à 7 couleurs.

A+

 

[Neo37]

Bonjour Job,
En effet ça fonctionne.
Pour le nombre de couleur possible que j'en ai besoin de plus, je suppose que je dois seulement en ajouter dans les choix, mais sûrement sous une autre forme que vbcolor, je chercherai.
Par contre comment fait-on pour limiter la macro à une zone précise?

 

[job75]

Pour le nombre de couleur possible que j'en ai besoin de plus, je suppose que je dois seulement en ajouter dans les choix, mais sûrement sous une autre forme que vbcolor, je chercherai.

RGB(x, y, z)

Par contre comment fait-on pour limiter la macro à une zone précise?

Set P = [A1:C10]

 

[Neo37]

J'étais partie sur un:
If Intersect(Target, Range("A1:C10")) Is Nothing Then Exit Sub

Mais c'est plus rapide.

Merci à toi Job.

 

[Neo37]

J'avoue que là j'abuse un peu, mais si je veux avoir le même résultat, mais en colorant aussi mes valeurs uniques? Chacune aussi d'une couleur différente.

 

[job75]

Bah enlevez If Application.CountIf(P, c) > 1 Then

    If c <> "" Then
        x = CStr(c)
        If Not d.exists(x) Then n = n + 1: d(x) = n
        nn = d(x)
        If nn <= ncoul Then
            c.Interior.Color = coulfond(nn - 1)
            c.Font.Color = coulpolice(nn - 1)
        End If
    End If

 

[Neo37]

J'en avais un poil trop enlever moi.

Merci encore