Coloré des cellules identiques

[aredo]

bonjour,

Ma demande est dans le fichier joint. Est-ce possible?
merci au fofo

 

[phlaurent55]

Re : Coloré des cellules identiques

Bonjour aredo

avec ce code à mettre dans un module

Sub Macro1()
Dim cel As Range
For i = 2 To 7
For Each cel In Range("A1:X22")
If cel.Value = Sheets(1).Cells(i, 3).Value Then
cel.Interior.ColorIndex = Sheets(1).Cells(i, 3).Interior.ColorIndex
End If
Next cel
Next i
End Sub

à+
Philippe

 

[Robert]

Re : Coloré des cellules identiques

Bonjour Aredo, Bonjour le forum,

En pièce jointe ton fichier modifié avec le code ci-dessous :

Sub Macro1()
Dim cel As Range 'déclare la variable cel (CELlule)
Dim coul As Byte 'déclare la variable coul (COULeur)
Dim r As Range 'déclare la variable r (Recherche)
Dim pa As String 'déclare la variable pa (Première Adresse)

For Each cel In Sheets("Inscrits").Range("C2:C7") 'boucle sur toutes les cellules de la plage C2:C7
    coul = cel.Interior.ColorIndex 'définit la couleur coul
    Set r = Sheets("Points").Cells.Find(cel.Value, , xlValues, xlWhole) 'définit la recherche r
    If Not r Is Nothing Then 'condition : si il existe au moins une occurrence trouvée
        pa = r.Address 'définit la première adresse pa
        Do 'exécute
            r.Interior.ColorIndex = coul 'colore la cellule de la couleur coul
            Set r = Sheets("Points").Cells.FindNext(r) 'redéfinit la recherche r (recherche occurrence suivante)
        Loop While Not r Is Nothing And r.Address <> pa 'boucle tant qu'il existe de nouvelles occurrences ailleurs qu'en pa
    End If 'fin de la condition
Next cel 'prochaine cellule de la boucle
End Sub

Le fichier :

[Édition]
Bonjour Philippe on s'est croisé...

 

[aredo]

Re : Coloré des cellules identiques

bonjour, phlaurent, robert

Merci pour votre code. Trop fort Robert, ça marche de feu de dieu!
bonne soirée