Colorer les "doublons" et les "triplons" avec deux couleurs différentes en VBA

[BChaly]

Bonjour à tous,

Le code suivant colorie les "doublons" de la colonne "A" en bleu.

Comment puis-je modifier ce code pour colorier les "triplons" dans une autre couleur?

Merci pour votre aide.

Cordialement

BChaly

Option Explicit
Sub DoubleValues()

Dim Cell As Range
Dim Co As Collection
    
Set Co = New Collection
On Error Resume Next

For Each Cell In Range("A1", Cells(Rows.Count, 2))
    If Cell <> "" Then
        Co.Add Cell, CStr(Cell)
            If Err <> 0 Then Cell.Interior.ColorIndex = 37
            '(L'instruction suivante ne donne pas le résultat souhaité):
            'If Err > 2 Then Cell.Interior.ColorIndex = 15
            Err.Clear
    End If
Next Cell

Set Co = Nothing
End Sub

 

[BOISGONTIER]

Re : Colorer les "doublons" et les "triplons" avec deux couleurs différentes en VBA

Bonjour,

cf PJ

Sub ColoriageDoublons()
  [A:A].Interior.ColorIndex = xlNone
  coul = Array(2, 3, 4, 5, 6, 7)
  Set d = CreateObject("Scripting.Dictionary")
  For Each c In Range("a2", [a65000].End(xlUp))
    If c <> "" Then d.Item(c.Value) = d.Item(c.Value) & c.Address & ":"
  Next c
  For Each c In d.keys
     tmp = d.Item(c)
     tmp = Left(tmp, Len(tmp) - 1)
     a = Split(tmp, ":")
     For i = LBound(a) To UBound(a)
       Range(a(i)).Interior.ColorIndex = coul(i)
     Next i
  Next c
End Sub

JB

 

[Modeste geedee]

Re : Colorer les "doublons" et les "triplons" avec deux couleurs différentes en VBA

Bonsour®
avec MEFC par macro :

Sub Macro2()
    Range("A1:A100").Select ' ***************plage à adapter
    Selection.FormatConditions.Add Type:=xlExpression, Formula1:= _
        "=NB.SI($A$1:A1;A1)=1"
    Selection.FormatConditions(Selection.FormatConditions.Count).SetFirstPriority
    With Selection.FormatConditions(1).Interior
        .PatternColorIndex = xlAutomatic
        .ThemeColor = xlThemeColorDark1
        .TintAndShade = 0
    End With
    Selection.FormatConditions(1).StopIfTrue = True
    Selection.FormatConditions.Add Type:=xlExpression, Formula1:= _
        "=NB.SI($A$1:A1;A1)=2"
    Selection.FormatConditions(Selection.FormatConditions.Count).SetFirstPriority
    With Selection.FormatConditions(1).Interior
        .PatternColorIndex = xlAutomatic
        .ThemeColor = xlThemeColorAccent1
        .TintAndShade = 0
    End With
    Selection.FormatConditions(1).StopIfTrue = True
    Selection.FormatConditions.Add Type:=xlExpression, Formula1:= _
        "=NB.SI($A$1:A1;A1)>2"
    Selection.FormatConditions(Selection.FormatConditions.Count).SetFirstPriority
    With Selection.FormatConditions(1).Interior
        .PatternColorIndex = xlAutomatic
        .ThemeColor = xlThemeColorAccent3
        .TintAndShade = 0
    End With
    Selection.FormatConditions(1).StopIfTrue = True
End Sub

 

[BChaly]

Re : Colorer les "doublons" et les "triplons" avec deux couleurs différentes en VBA

Bonjour BOISGONTIER,

Merci d'avoir étudié ma demande.

Le problème est que lorsqu'une valeur est représentée plus de 6 fois, j'obtiens un message d'erreur.
(ce qui est certainement normal en raison de l'instruction "Array(2, 3, 4, 5, 6, 7)").

Ce que je souhaiterais, c'est obtenir une couleur pour les doublons, et une autre couleur
pour les valeurs représentées 3 fois et plus.

Il y aurait donc deux couleurs différentes seulement.

Ex.
Valeur1 (sans couleur),
Valeur2 (couleur-1),
Valeur3 (couleur-2),
Valeur4 (couleur-2),
Valeur5 (couleur-2),
Valeur6 (Couleur-2) etc...

Merci pour votre aide.

Cordialement

BChaly

 

[BChaly]

Re : Colorer les "doublons" et les "triplons" avec deux couleurs différentes en VBA

Bonjour Modeste geedee,

Merci pour cette suggestion.

Malheureusement ceci ne semble pas fonctionner.

Cordialement,

BChaly

 

[BOISGONTIER]

Re : Colorer les "doublons" et les "triplons" avec deux couleurs différentes en VBA

Sub ColoriageDoublons()
  [A:A].Interior.ColorIndex = xlNone
  coul = Array(2, 3, 4)
  Set d = CreateObject("Scripting.Dictionary")
  For Each c In Range("a2", [a65000].End(xlUp))
    If c <> "" Then d.Item(c.Value) = d.Item(c.Value) & c.Address & ":"
  Next c
  For Each c In d.keys
     tmp = d.Item(c)
     tmp = Left(tmp, Len(tmp) - 1)
     a = Split(tmp, ":")
     For i = LBound(a) To UBound(a)
       If i < 3 Then Range(a(i)).Interior.ColorIndex = coul(i) Else Range(a(i)).Interior.ColorIndex = coul(2)
     Next i
  Next c
End Sub

JB

 

[BChaly]

Re : Colorer les "doublons" et les "triplons" avec deux couleurs différentes en VBA

Bonjour BOISGONTIER,

Super Génial!!! C'est exactement ce que je cherchais.

Immense Merci pour votre aide.

Cordialement

BChaly

 

[Modeste geedee]

Re : Colorer les "doublons" et les "triplons" avec deux couleurs différentes en VBA

Bonjour Modeste geedee,

Merci pour cette suggestion.

Malheureusement ceci ne semble pas fonctionner.

Cordialement,

BChaly

😕 😕 😕 😕

 

[BChaly]

Re : Colorer les "doublons" et les "triplons" avec deux couleurs différentes en VBA

Bonjour Modeste geedee,

Effectivement, ceci est également une solution intéressante et qui fonctionne.

Je vous remercie pour votre aide sympathique.

Cordialement

BChaly