Colorer cellules identiques en fonction d'une autre

[yves03]

Bonsoir à tous,

Je me bat un peu avec mon fichier pour colorer les cellules identiques en colonne C, si la cellule qui est en colonne H est coloré

Avec une MFC je colore la cellule en colonne H si elle est > 5
Avec une MFC je colore la cellule de la même ligne en colonne C , mais j'aimerais pouvoir aussi colorer en colonne C les cellules qui ont le même contenu .

Exemple :
Dans mon fichier ligne 2172 , la cellule H2172 est coloré et la cellule C2172 est aussi coloré, mais il y a 3 autres cellules identiques en C2173, 2174 et 2175, il faudrait aussi que je puisse les colorer.
Et la je n'y arrive pas !!

Merci d'avance pour votre aide

 

[mapomme]

Bonsoir yves03,

Pour la mFC sur la colonne C, essayez la formule :

=NB.SI.ENS($C$2:$C$9999;C2;$H$2:$H$9999;">5")>0

 

[job75]

Bonjour yves03, mapomme,

Ta formule mapomme met en couleur les cellules identiques même si elles sont très éloignées de la ligne de référence > 5.

Cela peut rendre la coloration incompréhensible.

Si l'on veut se limiter aux cellules contiguës on utilisera cette fonction VBA :

Function Contigues(c As Range) As Boolean
If c = "" Or c.Row = 1 Then Exit Function
Dim v, i&
v = c
For i = c.Row To 1 Step -1
    If Cells(i, 3) <> v Then Exit For
    If Cells(i, 8) > 5 Then Contigues = True: Exit Function
Next
For i = c.Row To Rows.Count
    If Cells(i, 3) <> v Then Exit Function
    If Cells(i, 8) > 5 Then Contigues = True: Exit Function
Next
End Function

Avec la formule de la MFC sur la colonne C entière :

=Contigues(C1)

Fichier .xlsm joint.

A+

 

[mapomme]

Bonjour job75

Ta formule mapomme met en couleur les cellules identiques même si elles sont très éloignées de la ligne de référence > 5.

C'est pas faux mais comme rien n'était précisé, j'ai osé... (ça m'était venu à l'esprit mais sans VBA pas facile )

 

[yves03]

Merci à tous les 2 pour votre aide

 

[job75]

Bonjour yves03, mapomme, le forum,

Ceci ne change rien mais je préfère :

Function Contigues(c As Range) As Boolean
If c = "" Or c.Row = 1 Then Exit Function
Dim v, i&
v = c
For i = 1 To c.Row
    If c(2 - i) <> v Then Exit For
    If c(2 - i, 6) > 5 Then Contigues = True: Exit Function
Next
For i = 2 To 1048577 - c.Row
    If c(i) <> v Then Exit Function
    If c(i, 6) > 5 Then Contigues = True: Exit Function
Next
End Function

Fichier (2).

Bonne journée.