Couleur différente selon les équipes sélectionner

  • Initiateur de la discussion Initiateur de la discussion marcelio
  • Date de début Date de début

Boostez vos compétences Excel avec notre communauté !

Rejoignez Excel Downloads, le rendez-vous des passionnés où l'entraide fait la force. Apprenez, échangez, progressez – et tout ça gratuitement ! 👉 Inscrivez-vous maintenant !

marcelio

XLDnaute Occasionnel
Bonjour,
Je fais un suivi d'un championnat amateur de foot et pour amélioré mon fichier
j'aimerais si cela est possible faire ceci.
Que je clic d'abord sur la cellule N13 ou sur P13 pour y inscrire le score du match entre Février et Mai
est t'il possible que les équipes qui sont dans le classement "ici Février et Mai"
soit de couleur différente comme le modèle

Un clic sur une cellule de n'importe quel match et cela me permet de voir rapidement la place des équipes dans le classement.
Si je clic sur P16 c'est Juin et Décembre qui seront de couleur différente.

Merci d'avance

Marcelio
 

Pièces jointes

Re : Couleur différente selon les équipes sélectionner

Bonjour marcelio,

Dans le code de la feuille :

Code:
Private Sub Worksheet_SelectionChange(ByVal target As Range)
With [AH8:AH19]
  .Interior.Color = [AH6].Interior.Color 'RAZ
  If Intersect(ActiveCell, [N13:P18]) Is Nothing Then Exit Sub
  Dim lig As Variant
  lig = Application.Match(Cells(ActiveCell.Row, "F"), .Cells, 0)
  If IsNumeric(lig) Then .Cells(lig).Interior.ColorIndex = 45
  lig = Application.Match(Cells(ActiveCell.Row, "R"), .Cells, 0)
  If IsNumeric(lig) Then .Cells(lig).Interior.ColorIndex = 45
End With
End Sub
Fichier joint.

A+
 

Pièces jointes

Dernière édition:
Re : Couleur différente selon les équipes sélectionner

Bonjour marcelio, Job, bonjour le forum,

Une autre option que celle de Job avec, comme lui, une macro événementielle SelectionChange.
Le code :

Code:
Private Sub Worksheet_SelectionChange(ByVal Target As Range) 'au changement de cellule active
Dim of1 As Integer, of2 As Integer 'déclare les variable of1 et of2 (OFfset1 et OFfset2)
Dim pl As Range 'déclare la variable pl (PLage)
Dim r1 As Range, r2 As Range 'déclare les variable r1 et r2 (Recherche 1 et Recherche 2)


If Selection.Cells.Count > 1 Then Exit Sub 'si plus d'une seule cellule séletionnée, sort de la procédure
Set pl = Range("AH8:AH18") 'définit la plage pl
pl.Interior.ColorIndex = 36 'enlève la couleur orange à toutes la plage pl
    Select Case Target.Column 'agit en fonction de la colonne de la cellule sélectionné
    Case 14 'cas 14 (=N)
        of1 = -8 'définit la variable of1
        of2 = 4 'définit la variable of2
    Case 16 'cas 16 (=P)
        of1 = -10 'définit la variable of1
        of2 = 2 'définit la variable of2
    Case Else 'tous les autres cas
        Exit Sub 'sort de la procédure
End Select 'fin de l 'action en fonction de ...
Set r1 = pl.Find(Target.Offset(0, of1).Value, , xlValues, xlWhole) 'définit la recherche r1
If Not r1 Is Nothing Then r1.Interior.ColorIndex = 45 'si au moins une occurrence est trouvé, colore d'orange la première occurrence trouvée
Set r2 = pl.Find(Target.Offset(0, of2).Value, , xlValues, xlWhole) 'définit la recherche r2
If Not r2 Is Nothing Then r2.Interior.ColorIndex = 45 'si au moins une occurrence est trouvé, colore d'orange la première occurrence trouvée
End Sub
Le fichier :
 

Pièces jointes

Re : Couleur différente selon les équipes sélectionner

Bonjour Job,Robert et Habitude,

Merci pour ces différentes solutions que vous me proposer elles sont toutes superbe.
Je fais garder celle de Job qui pour moi est la plus simple.

Je vous remercie de nouveau de votre aide et je vous souhaite une bonne soirée à tous les 3 et au forum.

Marcelio
 
Re : Couleur différente selon les équipes sélectionner

Re, salut Habitude,

Une MFC est une très bonne idée, voici une autre solution :

Code:
Private Sub Worksheet_SelectionChange(ByVal target As Range)
Me.Names.Add "T", Chr(1)
If Not Intersect(ActiveCell, [N13:P18]) Is Nothing Then _
Me.Names.Add "T", Cells(ActiveCell.Row, "F") & Cells(ActiveCell.Row, "R")
End Sub
Formule de la MFC sur AH8:AH19 :

Code:
=CHERCHE($AH8;T)
Fichier joint.

A+
 

Pièces jointes

- Navigue sans publicité
- Accède à Cléa, notre assistante IA experte Excel... et pas que...
- Profite de fonctionnalités exclusives
Ton soutien permet à Excel Downloads de rester 100% gratuit et de continuer à rassembler les passionnés d'Excel.
Je deviens Supporter XLD
Retour