XL 2016 Besoin d'aide ! Code BVA pour changer la couleur de 2 cellules d'une ligne si valeur identique

[Titi5333]

Bonjour,
J'ai besoin d'afficher une erreur (cellules passe en rouge ) si deux cellules ont la même valeur sur une ligne d'un tableau.
Je cherche un code BVA car si j'utilise une mise en forme conditionnelle, si je copie dans le tableau cela ne fonctionne plus.

Mon problème : je dois permettre sur un planning de réserver une salle (de 1à 7) sans que quelqu'un réserve la même salle.

J'aimerais si même salle sur la même ligne, alors les 2 cellules passe au rouge.

Merci d'avance pour votre aide !

 

[sylvanu]

Bonjour Titi et bienvenu sur XLD,
Je pense qu'on peut mettre ça en MFC, voir PJ.
Il suffit de mettre cette alerte rouge en 1er et d'interrompre les autres MFC si vrai :

 

[Titi5333]

Bonjour Sylvanu,
Merci !

J'ai déjà essayé cela ne fonctionne pas, les infirmières vont faire glisser la cellule pour réserver plusieurs 1/4 d'heure de réservation. c'est pour cela que je cherche un code VBA par ligne.

 

[sylvanu]

Re,
Je ne suis pas d'accord. Si vous tirez un créneau sur les suivant la MFC agit :

Prenez I8 et tirez le sur I9 alors I9 est bien rouge.

 

[Compte Supprimé 979]

Bonjour le fil,

Définir une plage nommé avec

=DECALER(Feuil5!$C$5;LIGNE()-5;1;1;24)

Et utiliser cette plage dans la MFC, logiquement plus aucun problème 🤔

@+

 

[sylvanu]

Re, bonjour Bruno,
Avec la MFC que j'ai mise je ne vois pas où est le problème quand on tire un créneau :

 

[Titi5333]

Génial ! merci Bruno !
Merci a tous pour votre aide !

 

[Compte Supprimé 979]

@sylvanu

Moi je l'ai vu de suite 😜 désolé 😂 un peut trop sur de soit hein 🤪

 

[Titi5333]

Re, bonjour Bruno,
Avec la MFC que j'ai mise je ne vois pas où est le problème quand on tire un créneau :
Regarde la pièce jointe 1119172

Merci beaucoup Sylvanu !

 

[Robert]

Bonjour le fil, Bonjour le forum,

Une proposition VBA avec la macro événementielle Change ci-dessous :

Private Sub Worksheet_Change(ByVal Target As Range) 'au changement dans l'onglet
Dim I As Integer 'déclare la variable I (Incrément)
Dim J As Byte 'déclare la variable J (incrément)
Dim K As Byte 'déclare la variable K (incrément)


Select Case Target.Column 'agit ne fonction de la colonne de la cellule modifiée (Target)
    Case 5, 7, 9, 11, 13, 15, 17, 19, 21, 23, 25, 27 'colonnes imparires de 5 à 27
        Select Case Target.Value 'agit en fonction de la valeur de la cellule modifiée
            'Mise en forme (plus conditionnelle mais par code)
            Case 1
                Target.Interior.Color = RGB(255, 199, 206)
                Target.Font.Color = RGB(156, 0, 6)
            Case 2
                Target.Interior.Color = RGB(255, 235, 156)
                Target.Font.Color = RGB(156, 101, 0)
            Case 3
                Target.Interior.Color = RGB(198, 239, 206)
                Target.Font.Color = RGB(0, 97, 0)
            Case 4
                Target.Interior.Color = RGB(91, 155, 213)
                Target.Font.Color = RGB(255, 255, 255)
            Case 5
                Target.Interior.Color = RGB(255, 255, 0)
                Target.Font.Color = RGB(255, 0, 0)
            Case 6
                Target.Interior.Color = RGB(0, 176, 240)
                Target.Font.Color = RGB(255, 255, 255)
            Case 7
                Target.Interior.Color = RGB(169, 208, 142)
                Target.Font.Color = RGB(255, 255, 255)
            Case Else
                Target.Interior.Color = RGB(255, 255, 255)
                Target.Font.Color = RGB(0, 0, 0)
        End Select 'fin de l'action en fonction de la valeur de la cellule
    For J = 5 To 25 Step 2 'boucle 1 : des colonnes 5 à 25
        For K = J + 2 To 27 'boucle 2 : des colonnes J+2 à 27
            If Not Cells(Target.Row, J).Value = "" Then 'condition 1 : si la cellule modifiée en colonne J n'est pas vide
                If Cells(Target.Row, J) = Cells(Target.Row, K) Then 'condition 2 : si la cellule modifiée en colonne J est égale à la cellule de la même ligne en colonne K
                    Cells(Target.Row, J).Interior.Color = RGB(255, 0, 0) 'fond rouge de la cellule modifié
                    Cells(Target.Row, J).Font.Color = RGB(0, 0, 0) 'encre noire de la celllue modifiée
                    Cells(Target.Row, K).Interior.Color = RGB(255, 0, 0) 'fond rouge de la cellule de la même ligne en colonne K
                    Cells(Target.Row, K).Font.Color = RGB(0, 0, 0) 'encre noire de la cellule de la même ligne en colonne K
                End If 'fin de la condition 2
            End If 'fin de la condition 1
        Next K 'prochaine colonne de la boucle 2
    Next J 'prochaine colonne de la boucle 1
End Select 'fin de l'action en fonctoion de la colonne de la celllue modifiée
End Sub

Le fichier :

 

[Titi5333]

Bonjour le fil, Bonjour le forum,

Une proposition VBA avec la macro événementielle Change ci-dessous :

Private Sub Worksheet_Change(ByVal Target As Range) 'au changement dans l'onglet
Dim I As Integer 'déclare la variable I (Incrément)
Dim J As Byte 'déclare la variable J (incrément)
Dim K As Byte 'déclare la variable K (incrément)


Select Case Target.Column 'agit ne fonction de la colonne de la cellule modifiée (Target)
    Case 5, 7, 9, 11, 13, 15, 17, 19, 21, 23, 25, 27 'colonnes imparires de 5 à 27
        Select Case Target.Value 'agit en fonction de la valeur de la cellule modifiée
            'Mise en forme (plus conditionnelle mais par code)
            Case 1
                Target.Interior.Color = RGB(255, 199, 206)
                Target.Font.Color = RGB(156, 0, 6)
            Case 2
                Target.Interior.Color = RGB(255, 235, 156)
                Target.Font.Color = RGB(156, 101, 0)
            Case 3
                Target.Interior.Color = RGB(198, 239, 206)
                Target.Font.Color = RGB(0, 97, 0)
            Case 4
                Target.Interior.Color = RGB(91, 155, 213)
                Target.Font.Color = RGB(255, 255, 255)
            Case 5
                Target.Interior.Color = RGB(255, 255, 0)
                Target.Font.Color = RGB(255, 0, 0)
            Case 6
                Target.Interior.Color = RGB(0, 176, 240)
                Target.Font.Color = RGB(255, 255, 255)
            Case 7
                Target.Interior.Color = RGB(169, 208, 142)
                Target.Font.Color = RGB(255, 255, 255)
            Case Else
                Target.Interior.Color = RGB(255, 255, 255)
                Target.Font.Color = RGB(0, 0, 0)
        End Select 'fin de l'action en fonction de la valeur de la cellule
    For J = 5 To 25 Step 2 'boucle 1 : des colonnes 5 à 25
        For K = J + 2 To 27 'boucle 2 : des colonnes J+2 à 27
            If Not Cells(Target.Row, J).Value = "" Then 'condition 1 : si la cellule modifiée en colonne J n'est pas vide
                If Cells(Target.Row, J) = Cells(Target.Row, K) Then 'condition 2 : si la cellule modifiée en colonne J est égale à la cellule de la même ligne en colonne K
                    Cells(Target.Row, J).Interior.Color = RGB(255, 0, 0) 'fond rouge de la cellule modifié
                    Cells(Target.Row, J).Font.Color = RGB(0, 0, 0) 'encre noire de la celllue modifiée
                    Cells(Target.Row, K).Interior.Color = RGB(255, 0, 0) 'fond rouge de la cellule de la même ligne en colonne K
                    Cells(Target.Row, K).Font.Color = RGB(0, 0, 0) 'encre noire de la cellule de la même ligne en colonne K
                End If 'fin de la condition 2
            End If 'fin de la condition 1
        Next K 'prochaine colonne de la boucle 2
    Next J 'prochaine colonne de la boucle 1
End Select 'fin de l'action en fonctoion de la colonne de la celllue modifiée
End Sub

Le fichier :

Merci beaucoup GENIAL ! vous êtes trop fort !