Coloration Doublons

[Pol]

Bonjour à tous,

J'ai actuellement une macro qui colore les doublons entre 2 colonnes (F et G). Elle présente 2 inconvénients que je souhaiterais corriger :

1 /Elle colore les zeros
2/ Elle colore avec une seule couleur

Quelqu'un pourrait-il m'aider ?

Je joins le fichier.

Merci bcp.

 

[Pierrot93]

Re : Coloration Doublons

Bonjour,

pour éviter les 0, faire un test la sorte :

For Each c In a
If c.value <> 0 Then
   MonDico1(c.Value) = c.Value
End If
  Next c

bonne journée
@+

 

[BOISGONTIER]

Re : Coloration Doublons

Bonjour,

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

Sub coloriecommuns()
  Set d = CreateObject("Scripting.Dictionary")
  couleurs = Array(1, 3, 4, 6, 7, 8, 15, 17, 20, 22, 24, 26, 27, 28, 33, 34, 35, 36, 37, 38, 39, 40, 42, 43, 44, 45, 46, 50, 53)
  Set plage1 = Range("f1:f" & [f65000].End(xlUp).Row)
  Set plage2 = Range("g1:g" & [g65000].End(xlUp).Row)
  Union(plage1, plage2).ClearComments
  Union(plage1, plage2).Interior.ColorIndex = xlNone
  For Each c In plage1
    If c <> 0 Then d.Item(c.Value) = d.Item(c.Value) & c.Row - plage1.Row + 1 & "-"
  Next c
  For Each c In plage2
   If c <> 0 Then
    If d.exists(c.Value) Then
       nocoul = (Application.Match(c.Value, d.keys, 0)) Mod UBound(couleurs)
       c.Interior.ColorIndex = couleurs(nocoul)
       a = Split(d.Item(c.Value), "-")
       For k = LBound(a) To UBound(a) - 1
         plage1(a(k)).Interior.ColorIndex = couleurs(nocoul)
       Next k
     End If
    End If
   Next c
End Sub

JB

 

[pierrejean]

Re : Coloration Doublons

Bonjour Pol

Salut Pierrot

A tester:

Sub ColorieCommuns()
  col = 3
  Set a = Range("F1:F" & [F65000].End(xlUp).Row)
  Set b = Range("G1:G" & [G65000].End(xlUp).Row)
  b.Interior.ColorIndex = xlNone
  a.Interior.ColorIndex = xlNone
  Set MonDico1 = CreateObject("Scripting.Dictionary")
  For Each c In a
   MonDico1(c.Value) = c.Row
  Next c
  For Each c In b
   If c.Value <> 0 And MonDico1.exists(c.Value) Then
      c.Interior.ColorIndex = col
      Range("F" & MonDico1(c.Value)).Interior.ColorIndex = col
      col = col + 1
   End If
  Next c
End Sub

Edit: Salut JB

 

[Pol]

Re : Coloration Doublons

Merci à tous,

Com d'hab c'est parfait !

A+