Excel 2007 mise en forme conditionnelle

[Résolu]
Signaler
Messages postés
2
Date d'inscription
vendredi 22 février 2008
Statut
Membre
Dernière intervention
27 décembre 2009
-
Messages postés
2
Date d'inscription
vendredi 22 février 2008
Statut
Membre
Dernière intervention
27 décembre 2009
-
[size=100]Bonsoir à tous.
Une feuille contient en colonne A des noms et en colonne B des numéros correspondants.
Des numéros sont communs à des noms différents.
Je souhaite que les noms correspondants au même numéro aient une forme de remplissage identique (même couleur).
Je n'arrive pas à créer la condition nécessaire.
Je crains d'appartenir encore aux quasi nuls...
Merci à tous.
PS : J'ai créé un petit fichier exemple que je pourrais transmettre.

3 réponses

Messages postés
3874
Date d'inscription
mardi 8 mars 2005
Statut
Modérateur
Dernière intervention
7 novembre 2014
14
Au fait, pour une question VBA, merci de poster sur vbfrance.com dans le thème :
Visual Basic 6 > Langages dérivés > VBA

[ Déplacé sur vbfrance.com ]
Messages postés
3874
Date d'inscription
mardi 8 mars 2005
Statut
Modérateur
Dernière intervention
7 novembre 2014
14
Bienvenue,

Voilà une piste de code :
Const NO_COLOR As Long = -4142

Private Sub CommandButton1_Click()
Dim nColor As Long
Dim nRow As Long
Dim nRow2 As Long
Dim nColumn As Long

' On efface les couleurs
nRow = 1
While Cells(nRow, 1).Value <> ""
  Cells(nRow, 1).Interior.ColorIndex = 0
  Cells(nRow, 2).Interior.ColorIndex = 0
  nRow = nRow + 1
Wend

nColor = 2
nRow = 1
While Cells(nRow, 1).Value <> ""
  ' On ne s'occupe pas des cellules qui ont déjà une correspondance
  If Cells(nRow, 1).Interior.ColorIndex = NO_COLOR Then
    ' On parcourt les cellules suivantes à la recherche d'un correspondance
    nRow2 = nRow + 1
    While Cells(nRow2, 1).Value <> ""
      If Cells(nRow, 2).Value = Cells(nRow2, 2).Value Then
        Cells(nRow, 1).Interior.ColorIndex = nColor
        Cells(nRow, 2).Interior.ColorIndex = nColor
        Cells(nRow2, 1).Interior.ColorIndex = nColor
        Cells(nRow2, 2).Interior.ColorIndex = nColor
      End If
      nRow2 = nRow2 + 1
    Wend
    
    ' Si on a trouvé des correspondance, on passe à la couleur suivante
    If Cells(nRow, 1).Interior.ColorIndex <> 0 Then
      nColor = nColor + 1
      If nColor > 57 Then
        MsgBox "Plus de couleurs disponibles"
        Exit Sub
      End If
    End If
  End If
  nRow = nRow + 1
Wend

End Sub
Messages postés
2
Date d'inscription
vendredi 22 février 2008
Statut
Membre
Dernière intervention
27 décembre 2009

Bravo et merci à rt15
Ce code mérite d'être connu des utilisateur d'excel.