Macro colorie cellule avec valeurs en double mais colorie aussi les cellules vide

[Sidonay]

Bonjour la communauté,

je suis en train de bloquer sur une macro >.< j'aurais besoin d'un petit coup de pouce pour arriver à mes fins

Voici mon petit problème j'ai trouvé une macro me permettant de colorier les valeurs des cellules en double.
(et adapté celle-ci à mon fichier)

Problème : elle colorie aussi les cellules vide ce que j'aimerais évité.

pour plus de compréhension voici le code :

Private Sub Worksheet_Change(ByVal Target As Range)

Application.ScreenUpdating = False

'doublon sur e/s physique
Range("Q10", [Q2000].End(xlUp)).Interior.ColorIndex = xlNone
Set mondico = CreateObject("Scripting.Dictionary")
For Each c In Range("Q10", [Q2000].End(xlUp))
mondico.Item(c.Value) = mondico.Item(c.Value) + 1
Next c
For Each c In Range("Q10", [Q2000].End(xlUp))
If mondico.Item(c.Value) > 1 Then c.Interior.Color = RGB(230, 185, 184)
Next c

Application.ScreenUpdating = True

End Sub

J'ai rajouté se morceau de code pour tenté de palier au problème :

For Each c In Range("Q10", [Q2000].End(xlUp))
If IsEmpty(Cel) Then c.Interior.ColorIndex = xlNone
Next c

c'est sans succès j'ai beau modifier et le tourné dans tout les sens je m'en sors pas quelqu'un pourrait-il m'aider ?

 

[Lolote83]

Re : Macro colorie cellule avec valeurs en double mais colorie aussi les cellules vid

Salut Sidonay,
Pourquoi ne pas passer par une MFC (Mise en forme conditionnelle) du style:
La formule est = NB.SI($Q$10:$Q$2000;Q10)>1 en appliquant la couleur souhaitée
Voir ici peut être
Cordialement
Lolote83

 

[DoubleZero]

Re : Macro colorie cellule avec valeurs en double mais colorie aussi les cellules vid

Bonjour, Sidonay, Lolote83, le Forum,

Une autre façon de faire :

Private Sub Worksheet_Change(ByVal Target As Range)
Application.ScreenUpdating = False
  Range("q10:q2000").Interior.ColorIndex = xlNone
  For Each c In Range("q10:q2000")
     If Application.CountIf([q10:q2000], c) > 1 Then c.Interior.Color = RGB(230, 185, 184)
  Next c
Application.ScreenUpdating = True
End Sub

A bientôt

 

[Sidonay]

Re : Macro colorie cellule avec valeurs en double mais colorie aussi les cellules vid

Parce que j'insère et supprime des lignes vide ou pleine, du coup excel m'est à jour la formule dans la MFC donc le $Q$2000 devient $Q$995 si je supprime des lignes ou devient $Q$9:$Q$998:$Q$2000 si j'insère.

l'avantage de la macro me permet de toujours gardé cette formule intacte quoi qu'il se passe sur le tableau.

 

[Sidonay]

Re : Macro colorie cellule avec valeurs en double mais colorie aussi les cellules vid

C'est super DoubleZero ça marche merci pour le coup de pouce j'ai juste optimisé le code pour le rendre plus rapide.

Private Sub Worksheet_Change(ByVal Target As Range)

Application.ScreenUpdating = False
Range("Q10", [Q2000].End(xlUp)).Interior.ColorIndex = xlNone
For Each c In Range("Q10", [Q2000].End(xlUp))
If Application.CountIf([Q10:Q2000], c) > 1 Then c.Interior.Color = RGB(230, 185, 184)
Next c
Application.ScreenUpdating = True

End Sub

j'ai juste du mal à comprendre le fonctionnement de Application.CountIf([Q10:Q2000], c) > 1 si jamais tu as le temps de me donner une brève explication se serait super. Et merci encore.

 

[DoubleZero]

Re : Macro colorie cellule avec valeurs en double mais colorie aussi les cellules vid

Re-bonjour,

...j'ai juste du mal à comprendre le fonctionnement de Application.CountIf([Q10:Q2000], c) > 1 ...

L'aide VBA mentionne :

Compte le nombre de cellules à l'intérieur d'une plage qui répondent aux critères donnés.

Cela équivaut à la fonction NB.SI.

A bientôt

 

[Sidonay]

Re : Macro colorie cellule avec valeurs en double mais colorie aussi les cellules vid

Voilà qui est plus clair =p merci pour ton aide.

A bientôt !

 

[WDAndCo]

Re : Macro colorie cellule avec valeurs en double mais colorie aussi les cellules vid

Bonjour le Forum

[Application.ScreenUpdating = False
  For Each c In Range("A1:A2000")
     If Application.CountIf([A1:A2000], c) > 1 Then c.Interior.Color = RGB(230, 1, 1)
  Next c
Application.ScreenUpdating = True/CODE]
Voici le code ici dessus adapté en partie à mes besoins, comme le modifier pour que les 2 cellules identiques passent au rouge ?

 

[Sidonay]

Re : Macro colorie cellule avec valeurs en double mais colorie aussi les cellules vid

Bonjour WDandCo,
je ne suis pas sur de bien comprendre cet une question que tu poses ou une réponse au sujet ?

 

[WDAndCo]

Re : Macro colorie cellule avec valeurs en double mais colorie aussi les cellules vid

Bonjour le Forum

Non, non, je ne suis pas assez "Excelent" pour répondre ! !

Application.ScreenUpdating = False
For Each c In Range("A1:A2000")
If Application.CountIf([A1:A2000], c) > 1 Then c.Interior.Color = RGB(230, 1, 1)
Next c
Application.ScreenUpdating = True

Voici une partie de code ici dessus adapté en partie à mes besoins, comment le modifier pour que les 2 cellules identiques passent au rouge ?

Car actuellement :
[012345678]
[987654321]
[012345678] seule celle-ci passe en rouge, je voudrait que tout les double passe en rouge, dans l'exemple le 1er et le 3emme.

Dominique

 

[Sidonay]

Re : Macro colorie cellule avec valeurs en double mais colorie aussi les cellules vid

Bonjour WDAndCo,
Jolie jeux de mot
Essaye avec ce code et dis moi si ça marche.

Range("A10", [A2000].End(xlUp)).Interior.ColorIndex = xlNone
  For Each c In Range("A10", [A2000].End(xlUp))
     If Application.CountIf([A10:A2000], c) > 1 Then c.Interior.Color = RGB(230, 1, 1)
  Next c

Il n'y a pas grand chose qui change mais chez moi il marche

 

[BOISGONTIER]

Re : Macro colorie cellule avec valeurs en double mais colorie aussi les cellules vid

Bonjour,

Ne pas utiliser CountIf() qui est très lent.

Sub ColoriageDoublons()
  [A:A].Interior.ColorIndex = xlNone
  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 mondico.Item(c.Value) > 1 Then c.Interior.ColorIndex = 4
  Next c
End Sub

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

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

JB
Formation Excel VBA JB

 

[Sidonay]

Re : Macro colorie cellule avec valeurs en double mais colorie aussi les cellules vid

*o* tu as résolu mon tout premier problème à la base effectivement le count if est très lent option que j'avais choisis par défaut ne trouvant pas de solution et bien merci!!

 

[WDAndCo]

Re : Macro colorie cellule avec valeurs en double mais colorie aussi les cellules vid

Bonjour le Forum

 '[A:A].Interior.ColorIndex = xlNone 'Je n'utilise pas car les cellules doivent restées en blanc ou gris, hors double
  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 mondico.Item(c.Value) > 1 Then c.Interior.ColorIndex = 3
  Next c

Donc le code est plus rapide, mais toujours le même souci sur les deux cellules identiques seule la 2mme passe au rouge la 1er reste dans sa couleur initial.

D'avance merci.

Dominique

 

[Sidonay]

Re : doubl colorie cellule avec valeurs en double mais colorie aussi les cellules vid

Bonjour,
je ne comprend pas se qui ne marche pas car moi le code colorie bien tout les doublons qu'il soit au dessus ou au dessous. Par contre et sa reste une supposition il faudrait que ta macro soit activé après avoir quitté la cellule contrôlé par exemple on contrôle la cellule A10 se positionner sur une cellule différente et la activée la macro et je pense que sa devrais fonctionner enfin moi c'est comme ça que je l'utilise.