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

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

pravdaz

XLDnaute Nouveau
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 ^^
 

Pièces jointes

  • Planning_Base_1.xlsx
    27.9 KB · Affichages: 15
Solution
Bonjour,
Une proposition par vba avec ce code en PJ
VB:
Private...

Jacky67

XLDnaute Barbatruc
Bonjour,
Une proposition par vba avec ce code en PJ
VB:
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
 

Pièces jointes

  • Planning_Base_1.xlsm
    34.7 KB · Affichages: 3
  • Planning_Base_1 V2.xlsm
    45.9 KB · Affichages: 6
Dernière édition:

Hasco

XLDnaute Barbatruc
Repose en paix
Bonjour,

Dans le module de code de la feuille :
VB:
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
 

Pièces jointes

  • Rob-Planning_Base_1.xlsm
    39.5 KB · Affichages: 10

pravdaz

XLDnaute Nouveau
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
 

Discussions similaires

Les cookies sont requis pour utiliser ce site. Vous devez les accepter pour continuer à utiliser le site. En savoir plus…