Ceci est une page optimisée pour les mobiles. Cliquez sur ce texte pour afficher la vraie page.

resolu : MFC sur meme nom

AKRAMI

XLDnaute Junior
Bonsoir tout le monde
svp comment faire pour realiser une MFC pour que les memes noms dans la colonne B prennent la meme couleur ..
Merci beaucoup d'avance pour l'aide
Amicalement
AKRAMI
 

Pièces jointes

  • MFC.xlsm
    36.3 KB · Affichages: 35
  • MFC.xlsm
    36.3 KB · Affichages: 33
Dernière modification par un modérateur:

djidji59430

XLDnaute Barbatruc
Re : MFC sur meme nom

Bonjour,

Si les memes noms prennent la même couleur, c'est que les autres prennent un couleur différente !
Donc autant de mfc que de noms différents.
Par exemple , pour s'applique à $B:$B, la condition =$B1="peche" te colore les pêches dans couleur que tu désires.

Edit : bonjour R@chid, je ne t'avais pas vu !
 
Dernière édition:

JCGL

XLDnaute Barbatruc
Re : resolu : MFC sur meme nom

Bonjour à tous,
Salut rachid,

Peux-tu essayer avec ceci :

VB:
Option Explicit

Sub Couleur()
    Dim Lig&, Texte As String
    Cells.Interior.ColorIndex = 0
    For Lig = 1 To 100
        Texte = Cells(Lig, 2).Value
        Select Case Texte
        Case Is = "Pêche"
            Cells(Lig, 2).Interior.ColorIndex = 40
        Case Is = "Cerise"
            Cells(Lig, 2).Interior.ColorIndex = 3
        Case Is = "Banane"
            Cells(Lig, 2).Interior.ColorIndex = 6
        Case Is = "Prune"
            With Cells(Lig, 2)
            .Interior.ColorIndex = 29
            .Font.ColorIndex = 2
            End With
        End Select
    Next
End Sub

A+ à tous
 

Pièces jointes

  • JC VBA Couleur.xlsm
    76.8 KB · Affichages: 33

Chris401

XLDnaute Accro
Re : resolu : MFC sur meme nom

Bonjour

Code de Boisgontier
Code:
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("B1", [B65000].End(xlUp))
    If c <> "" Then mondico.Item(c.Value) = mondico.Item(c.Value) + 1
  Next c
  For Each c In Range("B1", [B65000].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

Cordialement
Chris
 

AKRAMI

XLDnaute Junior
Re : resolu : MFC sur meme nom

Bonsoir JCGL .. Chris401 ..R@chid
Merci beaucoup a vous tous pour ces super solutions
Pour la remarque de R@achid ..je ne sais pas c'est pour le code de JCGL ou pour le code Boisgontier
Amicalement
AKRAMI
 
Les cookies sont requis pour utiliser ce site. Vous devez les accepter pour continuer à utiliser le site. En savoir plus…