Scripting.Dictionary

Bonjour,

Je n'ai pas vraiment saisi le sens de la question :
"mettre en couleur les doublons dans les deux mondico"

Si cela veut dire colorer les plages où tu copies le résultat
des 2 objets "MonDico"

Tu peux faire ceci :

ceci "Range("R" & Lig).Resize(1, MonDico2.Count)"
représente l'étendue de la plage de cellule.

With Range("R" & Lig).Resize(1, MonDico2.Count)
.value = MonDico2.items
.interior.ColorIndex = 25
.font.colorindex = 3
.font.bold = true
End with

Tu peux faire la même chose avec MonDico1





"PST" <pgjignorez@wanadoo.fr> a écrit dans le message de groupe de discussion :
4b5d9f55$0$925$ba4acef3@news.orange.fr...

Bonjour

Je cherche à mettre en couleur les doublons dans les deux mondico

merci



Sub Communs_2()

On Error Resume Next

For Lig = 3 To 100


Application.ScreenUpdating = False

a = Range("F" & Lig & ":H" & Lig)

Set MonDico1 = CreateObject("Scripting.Dictionary")
For Each c In a
If Not MonDico1.exists(c) Then MonDico1.Add c, c
Next c

b = Range("K" & Lig & ":P" & Lig)

Set MonDico2 = CreateObject("Scripting.Dictionary")
For Each c In b
If MonDico1.exists(c) Then If Not MonDico2.exists(c) Then
MonDico2.Add c, c
Next c

Range("R" & Lig).Resize(1, MonDico2.Count) = MonDico2.items


Next

Application.ScreenUpdating = True

End Sub

Bonjour.
Ca a l'air de fonctionner, sauf la ligne :
b = Range("K" & Lig & "" & Lig)
Tu devrais mettre quelque chose comme :
b = Range("K" & Lig & ":M" & Lig)
Daniel

Bonjour

Je cherche à mettre en couleur les doublons dans les deux mondico

merci



Sub Communs_2()

On Error Resume Next

For Lig = 3 To 100


Application.ScreenUpdating = False

a = Range("F" & Lig & ":H" & Lig)

Set MonDico1 = CreateObject("Scripting.Dictionary")
For Each c In a
If Not MonDico1.exists(c) Then MonDico1.Add c, c
Next c

b = Range("K" & Lig & ":P" & Lig)

Set MonDico2 = CreateObject("Scripting.Dictionary")
For Each c In b
If MonDico1.exists(c) Then If Not MonDico2.exists(c) Then MonDico2.Add
c, c
Next c

Range("R" & Lig).Resize(1, MonDico2.Count) = MonDico2.items


Next

Application.ScreenUpdating = True

End Sub

Merci

je voulais dire les deux ranges

J'ai compris le principe et vais essayer de l'adapter à :

b = Range("K" & Lig & ":P" & Lig)

pour les chiffres communs



Une autre approche, pas réussi à l'adapter venant du site de JB

For Each e In MonDico1
Range(MonDico1.Item(e)).Font.Color = IIf(MonDico2.Exists(e),
vbBlack, vbRed)
Next




Le 25/01/2010 15:50, michdenis a écrit :

Bonjour,

Je n'ai pas vraiment saisi le sens de la question :
"mettre en couleur les doublons dans les deux mondico"

Si cela veut dire colorer les plages où tu copies le résultat
des 2 objets "MonDico"

Tu peux faire ceci :

ceci "Range("R"& Lig).Resize(1, MonDico2.Count)"
représente l'étendue de la plage de cellule.

With Range("R"& Lig).Resize(1, MonDico2.Count)
.value = MonDico2.items
.interior.ColorIndex = 25
.font.colorindex = 3
.font.bold = true
End with

Tu peux faire la même chose avec MonDico1





"PST"<pgjignorez@wanadoo.fr> a écrit dans le message de groupe de di scussion :
4b5d9f55$0$925$ba4acef3@news.orange.fr...

Bonjour

Je cherche à mettre en couleur les doublons dans les deux mondico

merci



Sub Communs_2()

On Error Resume Next

For Lig = 3 To 100


Application.ScreenUpdating = False

a = Range("F"& Lig& ":H"& Lig)

Set MonDico1 = CreateObject("Scripting.Dictionary")
For Each c In a
If Not MonDico1.exists(c) Then MonDico1.Add c, c
Next c

b = Range("K"& Lig& ":P"& Lig)

Set MonDico2 = CreateObject("Scripting.Dictionary")
For Each c In b
If MonDico1.exists(c) Then If Not MonDico2.exists(c) Then
MonDico2.Add c, c
Next c

Range("R"& Lig).Resize(1, MonDico2.Count) = MonDico2.items


Next

Application.ScreenUpdating = True

End Sub