Microsoft 365 doublon différentes couleurs

[Moreno076]

Bonsoir.

J'ai regardé dans le forum mais je ne trouve pas la manière de rendre les doublons d une couleur différente.

Dans l exemple si dessous j aimerais que les doublons de la colonne C par exemple C6/C7 soit d une couleur et C8/C9 d'une autre etc...

Avez vous une solution à m'apporter? Merci

 

[James007]

Bonjour,

Le plus simple est tout de même de joindre un petit fichier test illustratif ...

 

[Moreno076]

et voilà

 

[James007]

Re,

Ci-joint ton fichier test

En espèrant que cela t'aide

 

[Moreno076]

en un mot : MERCI c'est parfait

 

[patricktoulon]

bonsoir
ouais!!
et le jour ou tu aura plus de 56 doublons ben tu t'arrachera les cheveux
LOL

Sub CouleurDoublons()
    Dim Rng As Range, Cell As Range, coul&, dicocel As Object, dicocoul As Object
    Randomize
    Set Rng = Range("C5:C15")
     Set dicocel = CreateObject("scripting.dictionary")
    Set dicocoul = CreateObject("scripting.dictionary")
    For Each Cell In Rng.Cells
        If Not dicocel.exists(Cell.Value) Then
re:
            coul = RGB(Rnd * 255, Rnd * 255, Rnd * 255)
            If Not dicocoul.exists(coul) Then dicocoul(coul) = "" Else GoTo re
            dicocel(Cell.Value) = coul
            Cell.Interior.Color = coul
        Else
            Cell.Interior.Color = dicocel(Cell.Value)
        End If
    Next
End Sub

ca me surprends de james007 que la coquille n'est pas été vue

 

[BOISGONTIER]

Bonsoir,

Un exemple où on choisit les couleurs et des commentaires indiquent les nos de ligne des doublons.

Boisgontier

 

[Moreno076]

Merci à tous j'ai retenu celle de Patrick même si parfois on ne voit pas la police ;-)

 

[patricktoulon]

bonsoir jacques
A verifier si test dico.exists plus rapide qu'un match dans le dico

 

[patricktoulon]

Merci à tous j'ai retenu celle de Patrick même si parfois on ne voit pas la police ;-)

je supose q'avec le test dico.exists on peux limiter les R G B a plus d'une certaine valeur histoire d'etre toujours avec des couleurs claires

 

[patricktoulon]

voila
R G B a 100 minimum

Sub CouleurDoublonspat()
    Dim Rng As Range, Cell As Range, coul&, dicocel As Object, dicocoul As Object
    Randomize
    Set Rng = Range("C5:C15")
     Set dicocel = CreateObject("scripting.dictionary")
    Set dicocoul = CreateObject("scripting.dictionary")
    For Each Cell In Rng.Cells
        If Not dicocel.exists(Cell.Value) Then
re:
            coul = RGB(100 + (Rnd * 155), 100 + (Rnd * 155), 100 + (Rnd * 155))
            If Not dicocoul.exists(coul) Then dicocoul(coul) = "" Else GoTo re
            dicocel(Cell.Value) = coul
            Cell.Interior.Color = coul
        Else
            Cell.Interior.Color = dicocel(Cell.Value)
        End If
    Next
End Sub

 

[Moreno076]

voila
R G B a 100 minimum

Sub CouleurDoublonspat()
    Dim Rng As Range, Cell As Range, coul&, dicocel As Object, dicocoul As Object
    Randomize
    Set Rng = Range("C5:C15")
     Set dicocel = CreateObject("scripting.dictionary")
    Set dicocoul = CreateObject("scripting.dictionary")
    For Each Cell In Rng.Cells
        If Not dicocel.exists(Cell.Value) Then
re:
            coul = RGB(100 + (Rnd * 155), 100 + (Rnd * 155), 100 + (Rnd * 155))
            If Not dicocoul.exists(coul) Then dicocoul(coul) = "" Else GoTo re
            dicocel(Cell.Value) = coul
            Cell.Interior.Color = coul
        Else
            Cell.Interior.Color = dicocel(Cell.Value)
        End If
    Next
End Sub

Plus que parfait Merci