créer une macro pour identifier cellules identiques dans colonne et mettre un format

  • Initiateur de la discussion Initiateur de la discussion merguez59
  • Date de début Date de début

Boostez vos compétences Excel avec notre communauté !

Rejoignez Excel Downloads, le rendez-vous des passionnés où l'entraide fait la force. Apprenez, échangez, progressez – et tout ça gratuitement ! 👉 Inscrivez-vous maintenant !

M

merguez59

Guest
Bonjour

J'ai des références dans une colonne.
Certaines sont exactement les mêmes. Je souhaite, à l'aide d'une macro, mettre en forme identique ces cellules (références) similaires.

Dans l'exmple du fichier joint, je veux que toutes les cellules qui contiennent WARP 300CM soient d'une couleur, celles qui contiennent BLEACHED d'une autre et ainsi de suite (avec un nombre infini (ou très important) de références)
Que le choix de la couleur soit aléatoire mais unique à chaque cellule identique. Donc par ex que les 3 cellules WARP 300CM soient rouges si c'est le rouge qui est choisi aléatoirement dès que la macro rencontre pour la première fois WARP 300CM.

Merci d'avance!
 

Pièces jointes

Re : créer une macro pour identifier cellules identiques dans colonne et mettre un fo

Bonjour, merguez59, le Forum,

Un gros merci à BOISGONTIER 🙂...

Code:
Sub Doublons_repérer()
'Merci, BOISGONTIER
  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

A bientôt 🙂
 
- Navigue sans publicité
- Accède à Cléa, notre assistante IA experte Excel... et pas que...
- Profite de fonctionnalités exclusives
Ton soutien permet à Excel Downloads de rester 100% gratuit et de continuer à rassembler les passionnés d'Excel.
Je deviens Supporter XLD
Assurez vous de marquer un message comme solution pour une meilleure transparence.

Discussions similaires

B
Réponses
4
Affichages
2 K
benoitoleron
B
C
Réponses
6
Affichages
2 K
C
S
Réponses
2
Affichages
1 K
StormRider
S
C
Réponses
11
Affichages
50 K
jordansoc
J
Retour