Microsoft 365 [Résolu] Couleurs doublons multiple

  • Initiateur de la discussion Initiateur de la discussion Neo37
  • Date de début Date de début

Boostez vos compétences Excel avec notre communauté !

Rejoignez Excel Downloads, le rendez-vous des passionnés où l'entraide fait la force. Apprenez, échangez, progressez – et tout ça gratuitement ! 👉 Inscrivez-vous maintenant !

Neo37

XLDnaute Junior
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.
 

Pièces jointes

Bonjour Neo37, Patrick, le forum,

Voyez le fichier .xlsm joint et cette macro dans le code de la feuille :
VB:
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+
 

Pièces jointes

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?
 
Bah enlevez If Application.CountIf(P, c) > 1 Then
VB:
    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
 
Dernière édition:
- Navigue sans publicité
- Accède à Cléa, notre assistante IA experte Excel... et pas que...
- Profite de fonctionnalités exclusives
Ton soutien permet à Excel Downloads de rester 100% gratuit et de continuer à rassembler les passionnés d'Excel.
Je deviens Supporter XLD

Discussions similaires

  • Question Question
Microsoft 365 Extraction doublon.
Réponses
19
Affichages
3 K
Retour