XL 2010 Surligner des cellules identiques d'un tableau à la sélection

[pravdaz]

Bonjour,
Je cherche depuis quelques temps une solution pour mon tableau mais je cale, je n'ai pas trouvé de code adapté, et je n'arrive pas à assembler les codes que j'ai pu trouver, faute de compétences en VBA...

J'ai un tableau hebdomadaire en B2:I54 sur une feuille contenant les noms du personnel pour chaque poste.
Une personne peut donc travailler 5 fois par semaine, sur différents postes.

Je cherche donc à surligner toutes les cellules contenant un nom identique à la cellule sélectionnée automatiquement. En cliquant sur un nom on visualiserais son placement par postes dans la semaine.

Si quelqu'un a le temps de me dépatouiller, je l'en remercie d'avance ^^

 

[Jacky67]

Bonjour,
Je cherche depuis quelques temps une solution pour mon tableau mais je cale, je n'ai pas trouvé de code adapté, et je n'arrive pas à assembler les codes que j'ai pu trouver, faute de compétences en VBA...

J'ai un tableau hebdomadaire en B2:I54 sur une feuille contenant les noms du personnel pour chaque poste.
Une personne peut donc travailler 5 fois par semaine, sur différents postes.

Je cherche donc à surligner toutes les cellules contenant un nom identique à la cellule sélectionnée automatiquement. En cliquant sur un nom on visualiserais son placement par postes dans la semaine.

Si quelqu'un a le temps de me dépatouiller, je l'en remercie d'avance ^^

Bonjour,
Une proposition par vba avec ce code en PJ

Private Sub Worksheet_SelectionChange(ByVal Target As Range)
    Dim C As Range, Tablo, Agent
    Set Tablo = Range("c5:i" & Cells.Find("*", , , , xlByRows, xlPrevious).Row)
    Set Agent = Range("k7:k" & Cells(Rows.Count, "p").End(xlUp).Row)
    Tablo.Interior.ColorIndex = xlNone: Agent.Interior.ColorIndex = xlNone
    If Intersect(Target, Agent) Is Nothing Or Target.Count > 1 Then Exit Sub
    Target.Interior.ColorIndex = 4
    For Each C In Tablo
        If C = Target.Offset(, 5) And C <> "" Then C.Interior.ColorIndex = 4
    Next
End Sub

**Version V2, s'il y a plusieurs semaines dans le même classeur.
**Code dans le thisworkbook

 

[Hasco]

Bonjour,

Dans le module de code de la feuille :

Private Sub Worksheet_SelectionChange(ByVal Target As Range)
'
' Si plus d'une cellule sélectionnées ou cellule hors de la plage, sortir
If Target.Count > 1 Or Intersect(Range("C5:I54"), Target) Is Nothing Then Exit Sub
' Conserver la valeur dans le nom définit "Selection.Nom" ou un point d'interrogation si cellule vide
 Application.Names.Add "Selection.Nom", IIf(IsEmpty(Target), "?", Target.Text)
End Sub

Formule MFC sur la plage C5:I54 :

C5 = Selection.Nom

Cordialement

 

[pravdaz]

Super !
Jackie67 ta solution est impeccable, c'est exactement ce que je cherchais.
Roblochon, je suis impressionné par la simplicité de ta solution !

Du coup, en cumulant les 2, cela permet de taguer 2 personnes c'est excellent
Je ne peux malheureusement pas mettre les 2 en solution sur le forum !

Merci beaucoup pour votre réactivité

Cordialement

Pravdaz