CHANGER COULEUR CELLULES DOUBLON Mais couleur différente !

[FILOU78180]

Bonjour ,
j'aimerai pouvoir visionner les doublons mais comme j'en ai beaucoup différentes 80 % des cellules se mettent en couleur choisie donc c pas gérable !
Ce que je souhaiterai ami expert excel 2010, c'est qu'a chaque doublons bien sûr cela change de couleur mais en plus à chaque doublon la couleur soit différente!

merci

 

[st007]

Re : CHANGER COULEUR CELLULES DOUBLON Mais couleur différente !

Bonjour,
une petite recherche t'aurais indiqué par exemple

 

[BOISGONTIER]

Re : CHANGER COULEUR CELLULES DOUBLON Mais couleur différente !

Bonjour,

http://boisgontierjacques.free.fr/fichiers/Cellules/ColorGroupe.xls

Sub GroupColor()
  couleurs = Array(1, 3, 4, 6, 7, 8, 14, 15, 17, 20, 22, 24, 26, 27, 28, 33, 34, 35, 36, 37, 38, 39, 40, 42, 43, 44, 45, 46, 50, 53)
  Set mondico = CreateObject("Scripting.Dictionary")
  For Each c In Range("a2", [a65000].End(xlUp))
    If c <> "" Then mondico.Item(c.Value) = mondico.Item(c.Value) + 1
  Next c
  For Each c In Range("a2", [a65000].End(xlUp))
    If c <> "" Then
      nocoul = (Application.Match(c.Value, mondico.keys, 0)) Mod UBound(couleurs)
      If mondico.Item(c.Value) > 1 Then c.Interior.ColorIndex = couleurs(nocoul)
    End If
  Next c
End Sub

JB

 

[gosselien]

Re : CHANGER COULEUR CELLULES DOUBLON Mais couleur différente !

Bonjour,

j'utilise cet excellent code depuis un moment mais je ne comprends pas bien cette ligne:

nocoul = (Application.Match(c.Value, mondico.keys, 0)) Mod UBound(couleurs)

On fait une recherche dans mondico.keys grâce à match mais la "jonction" avec le MOD et le mod lui même m'interpelle (restant d'une division mais ici je ne vois pas ...)

Merci JB de m'éclairer

P.

 

[BOISGONTIER]

Re : CHANGER COULEUR CELLULES DOUBLON Mais couleur différente !

Merci JB de m'éclairer

Sub GroupColor()
  couleurs = Array(3, 4, 6, 7, 8, 14, 15, 17, 20, 22, 24, 26, 27, 28, 33, 34, 35, 36, 37, 38, 39, 40, 42, 43, 44, 45, 46, 50, 53)
  Set mondico = CreateObject("Scripting.Dictionary")
  For Each c In Range("a2", [a65000].End(xlUp))
    If c <> "" Then mondico.Item(c.Value) = mondico.Item(c.Value) + 1
  Next c
  tableauClés = mondico.keys
  For Each c In Range("a2", [a65000].End(xlUp))
    If c <> "" Then
      nocoul = (Application.Match(c.Value, tableauClés, 0)) Mod UBound(couleurs)
      If mondico.Item(c.Value) > 1 Then
        c.Offset(, 1) = nocoul
        c.Offset(, 2) = couleurs(nocoul)
        c.Interior.ColorIndex = couleurs(nocoul)
      End If
    End If
  Next c
End Sub

JB

 

[gosselien]

Re : CHANGER COULEUR CELLULES DOUBLON Mais couleur différente !

Merci....

J'avais testé de la même manière ,mais j'avais omis de mettre Option Base 1, donc avant ça, au premier match il allait chercher la 2e couleur...
A présent il va chercher la 1er de l'array couleurs
Ca commence à entrer lentement dans mon cerveau mono ou bi-neurone sauf le mod qui reste ici d'une utilité que je ne pige pas

P.

 

[BOISGONTIER]

Re : CHANGER COULEUR CELLULES DOUBLON Mais couleur différente !

>sauf le mod qui reste ici d'une utilité que je ne pige pas

Supposons qu 'il y ait 51 clés et 30 couleurs dans la table Couleurs

51 Mod 30 -->couleur No 21

Sans Mod, nous prendrions la couleur No 51 qui n'existe pas dans la table Couleurs (qui n'en a que 30).

JB

 

[gosselien]

Re : CHANGER COULEUR CELLULES DOUBLON Mais couleur différente !

Ha.... bin oui

CQFD

Merci JB et dsl pour la lenteur de ma comprenette

 

[klin89]

Re : CHANGER COULEUR CELLULES DOUBLON Mais couleur différente !

Bonsoir à tous,

En s'appuyant sur le fichier de Jacques :

Option Explicit

Sub test()
    Dim rng As Range, r As Range, n As Long, couleurs
    Set rng = Range("a2", Range("a" & Rows.Count).End(xlUp))
    rng.Interior.ColorIndex = xlNone
    couleurs = VBA.Array(27, 38, 43, 44, 45, 40, 22, 19)
    With CreateObject("Scripting.Dictionary")
        For Each r In rng.Cells
            If Not .exists(r.Value) Then
                .Item(r.Value) = n
                n = n + 1
                If n > UBound(couleurs) Then n = 0
            End If
            r.Interior.ColorIndex = couleurs(.Item(r.Value))
        Next
    End With
    Set rng = Nothing
End Sub

klin89