Discussion :

[neomorpheus35]

Bonjour a tous
Alors je ne sais pas si le titre est très explicite mais je m'explique.
j'ai besoin pour le taf de faire en VBA
de trouvé de trouver des référence identique sur plusieurs critères.
c'est a dire toute les taille identique avec les mème couleurs et le même numéro ext...
et si les critère sont identique sur plusieurs ligne que la dernière case soit d'une couleur différente pour tout les doublon différent.
C'est a dire
G + I + L + M + N + P est identique sur plusieurs ligne la case T doit être d'une couleur
Et la couleur doit changé a chaque doublon différent.
J’espère que c'est clair et pas trop compliqué à faire
Merci à vous pour votre aide

[boisgontierjacques]

Bonjour,

Exemple en PJ

Boisgontier

[Menhir]

Je n'ai pas très bien compris ta question mais j'ai l'impression que ça pourrait se régler sans VBA en utilisant un NB.SI (ou NB.SI.ENS) dans une règle d'une mise en forme conditionnelle.

[neomorpheus35]

Merci Menhir j'y est bien pensé mais je n'ai besoin de faire cela que ponctuellement à l'aide d'un bouton en fait.

Merci aussi boisgontierjacques
C'est exactement ce que je veut faire.
Mais j'ai oublier de préciser que je suis débutant en VBA.
Mais je vais essayer de me débrouiller avec sa.
Sinon je revient vers vous.

[neomorpheus35]

Re boisgontierjacques

En parcourent ton site, j'ai trouver ce code que j'ai modifier selon mes recherche:

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
Sub DoublonsEntre2ColonnesCoulDiff()
  Set d = CreateObject("Scripting.Dictionary")
  couleurs = Array(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("G3:G" & [g300].End(xlUp).Row)
  Set plage2 = Range("I3:I" & [i300].End(xlUp).Row)
  Union(plage1, plage2).Interior.ColorIndex = xlNone
  For Each C In plage1
     d.Item(C.Value) = d.Item(C.Value) & C.Row & "-"
  Next C
  For Each C In plage2
     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
         tmp = a(k) - plage1.Row + 1
         plage1(tmp).Interior.ColorIndex = couleurs(nocoul)
       Next k
     End If
   Next C
End Sub

Par contre il me mes une erreur sur cette ligne

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

nocoul = (Application.Match(C.Value, d.keys, 0)) Mod UBound(couleurs)

Comment la corrigé?
Et est ce possible d'ajouté des des plage de recherche en plus?
Et comment faire pour ne mettre en couleur uniquement que les case de la colonne T correspondante au doublons?

encore merci pour ton aide.

[boisgontierjacques]

Bonjour,

Il doit y avoir des celles vides.

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
 
Sub DoublonsEntre2ColonnesCoulDiff()
  Set d = CreateObject("Scripting.Dictionary")
  couleurs = Array(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("G3:G" & [g300].End(xlUp).Row)
  Set plage2 = Range("I3:I" & [i300].End(xlUp).Row)
  Union(plage1, plage2).Interior.ColorIndex = xlNone
  For Each C In plage1
     If C.Value <> "" Then d.Item(C.Value) = d.Item(C.Value) & C.Row & "-"
  Next C
  For Each C In plage2
     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
         tmp = a(k) - plage1.Row + 1
         plage1(tmp).Interior.ColorIndex = couleurs(nocoul)
       Next k
     End If
   Next C
End Sub

Boisgontier

[neomorpheus35]

En effet j'ai des cases vide par moment.
J'ai fait la correction de code je n'ai plu d'erreur mais il ne se passe rien?
Avez vous une solution?
Merci

[neomorpheus35]

Bonsoir
Alors en fait je me suis trompé de code

C'est plutôt celui ci qu'il me faut

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
11
12
13
Sub GroupColor2CritèresColAColC()
  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))
    clé = c.Value & c.Offset(, 2)
    mondico.Item(clé) = mondico.Item(clé) + 1
  Next c
  For Each c In Range("a2", [a65000].End(xlUp))
    clé = c.Value & c.Offset(, 2)
    nocoul = (Application.Match(clé, mondico.keys, 0)) Mod UBound(couleurs)
    If mondico.Item(clé) > 1 Then c.Resize(, 4).Interior.ColorIndex = couleurs(nocoul)
  Next c
End Sub

Cela fonctionne bien sauf que j'ai besoin de faire la recherche sur 6 critère G + I + L + M + N + P
et qu'il faudrait uniquement de la couleur dans la colonne T

et la je n'y arrive pas de l'aide SVP

[neomorpheus35]

J'ai finalement réussie

Voici le code pour ceux que ça intéresse.

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
11
12
13
Sub GroupColor()
  couleurs = Array(3, 4, 5, 6, 7, 8, 10, 13, 14, 17, 22, 23, 25, 26, 27, 29, 33, 38, 39, 42, 43, 44, 46, 47, 49, 50, 53, 54)
  Set mondico = CreateObject("Scripting.Dictionary")
  For Each c In Range("B3", [b100].End(xlUp))
    clé = c.Value & c.Offset(, 2) & c.Offset(, 5) & c.Offset(, 6) & c.Offset(, 7) & c.Offset(, 9)
    mondico.Item(clé) = mondico.Item(clé) + 1
  Next c
  For Each c In Range("B3", [b100].End(xlUp))
    clé = c.Value & c.Offset(, 2) & c.Offset(, 5) & c.Offset(, 6) & c.Offset(, 7) & c.Offset(, 9)
    nocoul = (Application.Match(clé, mondico.keys, 0)) Mod UBound(couleurs)
    If mondico.Item(clé) > 1 Then c.Offset(, 13).Interior.ColorIndex = couleurs(nocoul)
  Next c
End Sub

Merci de votre aide