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

tarokain

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

Pièces jointes

  • TEST.xlsx
    70.6 KB · Affichages: 7

Staple1600

XLDnaute Barbatruc
Bonsoir le fil

Un exemple sommaire
[à mettre dans le code de la feuille]
VB:
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

XLDnaute Nouveau
Bonsoir le fil

Un exemple sommaire
[à mettre dans le code de la feuille]
VB:
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

XLDnaute Barbatruc
Bonsoir

Comme ceci, tu veux dire?
VB:
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
 

Discussions similaires

Réponses
8
Affichages
234
Réponses
2
Affichages
425

Statistiques des forums

Discussions
312 843
Messages
2 092 748
Membres
105 520
dernier inscrit
Inconnuto