XL 2019 Surligner ligne et colonne de la sélection actuelle VBA

[tarokain]

Bonjour à tous,

Je souhaiterai s'il vous plait une solution (forcément VBA), pour que la colonne et la ligne soient surlignés en une couleur. La seule difficulté que je souhaiterai apporter c'est que je veux que toutes les lignes qui ont les mêmes dates soient surlignées (j'ai donné un exemple en pièces jointes).

Exemple :
J'ai deux tableaux avec des dates par jour allant du 1er au 30, un tableau est au dessus l'autre, ce que je veux faire c'est que si je vais sur une cellule du premier tableau dont la date correspond au 5, je veux que cette soit surligné sur la date du 5 des deux tableaux...

(je suis en calcul manuel, donc j'utilise le Application.screenupdating).

Merci beaucoup !

 

[Staple1600]

Bonsoir le fil

Un exemple sommaire
[à mettre dans le code de la feuille]

Private Sub Worksheet_SelectionChange(ByVal Target As Range)
Dim x&
Rows("3:71").Interior.ColorIndex = xlNone
If Not Intersect(Range("E3:E32"), Target) Is Nothing Then
x = Application.Match(Target, Range("E41:E71"), 0) + 40
Target.EntireRow.Interior.Color = vbYellow
Rows(x).Interior.Color = vbYellow
End If
End Sub

 

[tarokain]

Bonsoir le fil

Un exemple sommaire
[à mettre dans le code de la feuille]

Private Sub Worksheet_SelectionChange(ByVal Target As Range)
Dim x&
Rows("3:71").Interior.ColorIndex = xlNone
If Not Intersect(Range("E3:E32"), Target) Is Nothing Then
x = Application.Match(Target, Range("E41:E71"), 0) + 40
Target.EntireRow.Interior.Color = vbYellow
Rows(x).Interior.Color = vbYellow
End If
End Sub

Hello !

Merci beaucoup pour ton aide !

Le seul petit détail qui manquerait c'est que je souhaiterai que le surlignement reste affiché quand je me déplace sur les autres cellules aussi. Dans ce cas, le surlignement apparait que si je suis sur la colonne E, dès que je bouge ailleurs, il disparait...

Merci encore !

 

[Staple1600]

Bonsoir

Comme ceci, tu veux dire?

Private Sub Worksheet_SelectionChange(ByVal Target As Range)
Dim x&
REM Rows("3:71").Interior.ColorIndex = xlNone
If Not Intersect(Range("E3:E32"), Target) Is Nothing Then
x = Application.Match(Target, Range("E41:E71"), 0) + 40
Target.EntireRow.Interior.Color = vbYellow
Rows(x).Interior.Color = vbYellow
End If
End Sub