Identification de toutes les valeurs identiques

[blord]

Bonjour à tous,

Grâce à ce code trouver sur le Forum (merci à Boisgontier) :

Sub ListeDoublons()
  Set mondico1 = CreateObject("Scripting.Dictionary")
  Set mondico2 = CreateObject("Scripting.Dictionary")
  For Each c In [A2:A20]
    temp = c.Value
    If Not mondico1.exists(temp) Then
      mondico1.Add temp, temp
    Else
      mondico2.Add c.Address, temp
      c.Interior.ColorIndex = 4
    End If
  Next c
End Sub

Il est possible de mettre en vert les cellules en doubles. J'aimerais savoir s'il est possible de modifier ce code pour mettre en vert toutes les cellules identiques ? Je m'explique :

Si en A1 j'ai la valeur Pomme
Si en A2 j'ai la valeur Pomme

Avec le code plus haut, seule la cellule A2 serait mise en vert, j'aimerais également que la cellule A1 soit aussi coloriée en vert. Est-ce possible ?

Merci pour votre aide....

Benoit Lord

 

[Softmama]

Re : Identification de toutes les valeurs identiques

Bonjour, A tester, mais tu devrais pouvoir faire comme ceci :

Sub ListeDoublons()
  Set mondico1 = CreateObject("Scripting.Dictionary")
  Set mondico2 = CreateObject("Scripting.Dictionary")
  For Each c In [A2:A20]
    temp = c.Value
    If Not mondico1.exists(temp) Then
      mondico1.Add temp, temp
[COLOR="Red"]      If c.Row <>20 then
         If Not Range("A" & c.Row+1 & ":A20").Find(What:=temp, Lookin:=xlValues, Looat:=xlWhole) is Nothing then
         c.interior.ColorIndex = 4
        end If
       end If[/COLOR]
    Else
      mondico2.Add c.Address, temp
      c.Interior.ColorIndex = 4
    End If
  Next c
End Sub

 

[blord]

Re : Identification de toutes les valeurs identiques

Bonjour Softmama, le Forum...

Merci pour ton aide, ça fonctionne parfaitement...

Benoit Lord