Microsoft 365 Tester si ligne à changer après une nouvelle sélection

Ludwig74 · 9 Avril 2021

Bonsoir à tous,
Est-il possible de tester, lors d'un changement de sélection, si la ligne de la nouvelle sélection est différente de la sélection précédente ?
J'aimerais pouvoir exécuter une macro au moment où je change de ligne.
Le changement de sélection peut se faire, soit avec les curseurs, soit par clic de la souris.

Par avance.

Ludwig

Dudu2 · 10 Avril 2021

Ce code répond à ta question:

Est-il possible de tester, lors d'un changement de sélection, si la ligne de la nouvelle sélection est différente de la sélection précédente ?

Code:

Private LigneSélectionPrécédente As Long

Private Sub Worksheet_SelectionChange(ByVal Target As Range)
    If Target.Rows.Count <> 1 Then
        MsgBox "Plusieurs lignes sélectionnées, trop c'est trop !"
        LigneSélectionPrécédente = 0
        Exit Sub
    End If
    
    If LigneSélectionPrécédente > 0 Then
        If Target.Row <> LigneSélectionPrécédente Then
            MsgBox "Ligne sélectionnée différente"
        Else
            MsgBox "Ligne sélectionnée identique"
        End If
    End If
    
    LigneSélectionPrécédente =...

Dudu2 · 10 Avril 2021

Bonjour,
Il te suffit de garder la ligne à chaque sélection et de la comparer à la sélection suivante.

si la ligne de la nouvelle sélection est différente de la sélection précédente

Difficile de savoir ce qui pour toi fait qu'une ligne est différente d'une autre, mais si c'est l'ensemble des cellules alors il faut une table de Variant pour stocker les valeurs d'une ligne.

Ludwig74 · 10 Avril 2021

Bonjour,
Merci d'avoir pris le temps de me lire et surtout de me répondre.
Suite à ta réponse voilà ce que j'ai fait.

VB:

Public IntLg As Integer

Private Sub Worksheet_SelectionChange(ByVal Target As Range)
    Cells(1, 1) = Target.Row
    IntLg = Cells(1, 1)
End Sub
 
Private Sub Worksheet_Change(ByVal Target As Range)
    If IntLg <> Target.Row Then Cells(1, 1).Interior.ColorIndex = Int(50 * Rnd) + 1
End Sub

Lors d'un changement de sélection, j'inscris le n° de ligne dans une cellule et ensuite je teste si une modification a été faite dans la cellule.
Bon ok, je n'ai pas de tableau comme tu me l'as suggéré.
Mais, ça fonctionne.
Maintenant, je souhaiterais avoir le même résultat sans passer par une cellule.
Ne connaissant pas les tableaux, ça risque d'être un peu ardu.

Encore merci.

Ludwig

Dudu2 · 10 Avril 2021

Ce code fera exactement la même chose. Même si je ne comprends pas du tout le but de ton code vu qu'avant de modifier on est bien obligé de sélectionner. Pas forcément la totalité du Range de Change (ex Copier 3 cellules et Coller sur 1) ou pas forcément la totalité du Range de Sélection (ex étendre les valeurs avec le petit carré en bas droit de cellule).
De plus une Target de Sélection ou de Change peut contenir plusieurs Areas.

Pour finir ce code n'a absolument rien à voir avec la question que tu poses:

Est-il possible de tester, lors d'un changement de sélection, si la ligne de la nouvelle sélection est différente de la sélection précédente ?

VB:

Private IntLg As Long

Private Sub Worksheet_SelectionChange(ByVal Target As Range)
    IntLg = Target.Row
End Sub

Private Sub Worksheet_Change(ByVal Target As Range)
    If IntLg <> Target.Row Then Cells(1, 1).Interior.ColorIndex = Int(50 * Rnd) + 1
End Sub

Dudu2 · 10 Avril 2021

Ce code répond à ta question:

Est-il possible de tester, lors d'un changement de sélection, si la ligne de la nouvelle sélection est différente de la sélection précédente ?

Code:

Private LigneSélectionPrécédente As Long

Private Sub Worksheet_SelectionChange(ByVal Target As Range)
    If Target.Rows.Count <> 1 Then
        MsgBox "Plusieurs lignes sélectionnées, trop c'est trop !"
        LigneSélectionPrécédente = 0
        Exit Sub
    End If
    
    If LigneSélectionPrécédente > 0 Then
        If Target.Row <> LigneSélectionPrécédente Then
            MsgBox "Ligne sélectionnée différente"
        Else
            MsgBox "Ligne sélectionnée identique"
        End If
    End If
    
    LigneSélectionPrécédente = Target.Row
End Sub

Ludwig74 · 10 Avril 2021

Je pense avoir trouvé une solution en suivant ta suggestion des tables.

VB:

Public IntLg As Long
Dim itab(0) As Long
Dim itab1(0) As Long

Private Sub Worksheet_SelectionChange(ByVal Target As Range)

Application.EnableEvents = False
    
    IntLg = Target.Row
    'chgtlg
        itab1(0) = ActiveCell.Row
    If itab(0) <> itab1(0) Then
        Cells(1, 1).Interior.ColorIndex = IntLg
    End If
    itab(0) = itab1(0)
    
Application.EnableEvents = True

End Sub

Je regarde ta proposition de code.

Encore merci.

Ludwig

Ludwig74 · 10 Avril 2021

Dudu2 à dit:

Ce code répond à ta question:

Code:

Private LigneSélectionPrécédente As Long

Private Sub Worksheet_SelectionChange(ByVal Target As Range)
    If Target.Rows.Count <> 1 Then
        MsgBox "Plusieurs lignes sélectionnées, trop c'est trop !"
        LigneSélectionPrécédente = 0
        Exit Sub
    End If
   
    If LigneSélectionPrécédente > 0 Then
        If Target.Row <> LigneSélectionPrécédente Then
            MsgBox "Ligne sélectionnée différente"
        Else
            MsgBox "Ligne sélectionnée identique"
        End If
    End If
   
    LigneSélectionPrécédente = Target.Row
End Sub

C'est parfait ! Merci beaucoup pour ton aide.
Je te souhaite un bon week-end et à bientôt.

Ludwig74 · 10 Avril 2021

Une seule table peut suffire.

VB:

Public IntLg As Long
Dim itab(1) As Long

Private Sub Worksheet_SelectionChange(ByVal Target As Range)

Application.EnableEvents = False

On Error Resume Next
    
    IntLg = Target.Row
        itab(1) = ActiveCell.Row
    If itab(0) <> itab(1) Then
        Cells(1, 1).Interior.ColorIndex = Int(50 * Rnd) + 1
    End If
    itab(0) = itab(1)

Application.EnableEvents = True

End Sub

Encore merci.

Ludwig

Microsoft 365 Tester si ligne à changer après une nouvelle sélection

Ludwig74

XLDnaute Nouveau

Dudu2

Dudu2

XLDnaute Barbatruc

Ludwig74

XLDnaute Nouveau

Dudu2

XLDnaute Barbatruc

Dudu2

XLDnaute Barbatruc

Ludwig74

XLDnaute Nouveau

Ludwig74

XLDnaute Nouveau

Ludwig74

XLDnaute Nouveau

Discussions similaires