Application.Intersect / Récupéré le numéro de la ligne du changement

Le 06/05/2024 à 14:09

Bonjour à tous,

J'essaie de créer une macro pour vérifier des changements dans un tableau. Pour cela j'ai nommé une plage de menus déroulants que j'utilise dans la macro.

J'ai testé avec un MsgBox et cela fonctionne bien, j'aimerai maintenant pouvoir récupérer la ligne de la plage sur laquelle le changement a été fait, pour pouvoir continuer un code derrière mais je n'ai pas réussi pour l'instant et n'ai pas trouvé d’exemple sur le net... Sauriez-vous comment faire ?

Merci ;)

    If Not Application.Intersect([Nom_Plage], Range(Target.Address)) Is Nothing Then
     ...
    End If
Le 06/05/2024 à 14:19

Bon j'ai fini par trouver... 

Sub Worksheet_Change(ByVal Target As Range)

    Dim x As Integer
    Dim y As Integer

    Application.ScreenUpdating = False
    Audit.Activate

    x = Target.Row
    y = Target.Column

    If Not Application.Intersect([Conforme_1], Range(Target.Address)) Is Nothing Then
    MsgBox x

    End If

End Sub
Le 06/05/2024 à 14:48

oubien

Sub Worksheet_Change(ByVal Target As Range)
dim c as range
       set c=Intersect(Me.range("Conforme_1"), Target) 
if c Is Nothing Then exit sub
    MsgBox c.row & vblf & c.column & vblf & c.address

End Sub
Le 06/05/2024 à 15:00

En effet cela fonctionne aussi.

J'ai un autre soucis, et ne sais pas si cela peut se faire. J'ai récupéré mes valeurs X/Y, j'ai trois colonnes et voudrais que si je change la colonne A, il supprimes les valeurs dans la ligne X de la colonne B et C, sachant que j'ai 3 plages. Pour l'instant il tourne en boucle avant de crasher, peut-on le faire ?

Option Explicit
Sub Worksheet_Change(ByVal Target As Range)

    'Déclaration des variables
    Dim X As Integer
    Dim Y As Integer

    Application.ScreenUpdating = False
    Audit.Activate

    X = Target.Row
    Y = Target.Column

    If Not Application.Intersect([Conforme], Range(Target.Address)) Is Nothing Then
        MsgBox X
        MsgBox Y
        Cells(X, 19) = vbNullString
        Cells(X, 21) = vbNullString
        Exit Sub
    Else
        If Not Application.Intersect([Non_conforme], Range(Target.Address)) Is Nothing Then
            MsgBox X
            MsgBox Y
            Cells(X, 17) = vbNullString
            Cells(X, 21) = vbNullString
            Exit Sub
        Else
            If Not Application.Intersect([Non_applicable], Range(Target.Address)) Is Nothing Then
                MsgBox X
                MsgBox Y
                Cells(X, 17) = vbNullString
                Cells(X, 19) = vbNullString
                Exit Sub
            End If
        End If
    End If

End Sub

Merci.

Le 06/05/2024 à 15:28

re, un exemple, il existe la possibilité que vous changez plusieurs cellules en même temps, il faut faire quoi dans ce cas ? (voir 1ere et 2eme cas), mais tout dépend de ce que vous voulez.

Sub Worksheet_Change(ByVal Target As Range)

     'Déclaration des variables
     Dim c     As Range, c0

     Application.EnableEvents = False        'bloquer temporairement les évents

     Set c = Nothing: Set c = Intersect(Me.Range("Conforme"), Target.Address)
     If Not c Is Nothing Then
          If c.Cells.Count > 1 Then          'si on veut seulement traiter une cellule
               MsgBox "plusieurs cellules"
          Else
               c.Offset(, 19 - c.Column).Value = vbNullString
               c.Offset(, 21 - c.Column).Value = vbNullString
          End If
     End If

     Set c = Nothing: Set c = Intersect(Me.Range("Non_Conforme"), Target.Address)
     If Not c Is Nothing Then
          For Each c0 In c.Cells             'traitement de plusieurs cellules
               c0.Offset(, 17 - c.Column).Value = vbNullString
               c0.Offset(, 21 - c.Column).Value = vbNullString
          Next
     End If

     Set c = Nothing: Set c = Intersect(Me.Range("Non_applicable"), Target.Address)
     If Not c Is Nothing Then
          If c.Cells.Count > 1 Then
               MsgBox "plusieurs cellules"
          Else
               c.Offset(, 17 - c.Column).Value = vbNullString
               c.Offset(, 21 - c.Column).Value = vbNullString
          End If
     End If

     Application.EnableEvents = True

End Sub
Le 06/05/2024 à 16:15

Mais oui j'oublie toujours ce Application.EnableEvents = False

Du coup cela fonctionne nickel avec ce code:

Sur ma plage "Réponse" qui comprend 3 colonnes (17/19/21), si une des valeurs est changée par exemple colonne 17 / ligne 32, il récupère la ligne 32, et supprime les valeurs des colonnes 19/21 de la même ligne. Le but étant d'avoir une seul réponse parmi les 3 colonnes d'une même ligne.

Merci pour ton aide, il faut que je code plus souvent je rouille quand je ne pratique pas...

Option Explicit
Sub Worksheet_Change(ByVal Target As Range)

    'Déclaration des variables
    Dim X As Integer
    Dim Y As Integer

    Application.ScreenUpdating = False
    Audit.Activate
    Application.EnableEvents = False

    X = Target.Row
    Y = Target.Column

    If Not Application.Intersect([Réponse], Range(Target.Address)) Is Nothing Then
        MsgBox X
        MsgBox Y
        If Y = 17 Then
            Cells(X, 19) = vbNullString
            Cells(X, 21) = vbNullString
        End If
        If Y = 19 Then
            Cells(X, 17) = vbNullString
            Cells(X, 21) = vbNullString
        End If
        If Y = 21 Then
            Cells(X, 17) = vbNullString
            Cells(X, 19) = vbNullString
        End If
    End If

    Application.EnableEvents = True

End Sub
Le 06/05/2024 à 20:02

re,

je pense que vous n'avez pas fait attention. C'est un tableau structuré, donc quand vous ajoutez ou supprimez une ligne, le target sera la ligne complète, donc le nombre de cellules modifées sera le nombre de listcolumns. Dans ce cas, la colonne de target sera toujours la première colonne du tableau.

Je soupçonne que vous verrez encore des choses étranges/inattendues avec votre code. Par première précaution j'ajouterais cette ligne en haut

if target.cells.count > 1 then exit sub

Puis "Audit.Activate", c'est mieux de jamais faire cela, cela ralentit la macro et n'ajoute pas de valeur ajoutée. (Et comme vous voulez activer cette feuille, c'est mieux d'utiliser "Me.activate")

Le 06/05/2024 à 20:31

Bonsoir @ vous deux !

si je peux me permettre, je suis parti du fait que seule la dernière donnée est à garder, donc je stocke, j'efface, j'écris :

Private Sub Worksheet_Change(ByVal Target As Range)
    Dim Plage As Range, CRef As Integer, Temp
    If Target.CountLarge > 1 Then Exit Sub
    Set Plage = Union(Range("MonTab[Entête 17]"), Range("MonTab[Entête 19]"), Range("MonTab[Entête 21]"))
    If Not Intersect(Target, Plage) Is Nothing Then
        Application.EnableEvents = False
            Temp = Target
            CRef = Range("MonTab[Entête 17]").Column
            Cells(Target.Row, CRef).Value = vbNullString
            Cells(Target.Row, CRef).Offset(, 2) = vbNullString
            Cells(Target.Row, CRef).Offset(, 4) = vbNullString
            Target.Value = Temp
        Application.EnableEvents = True
    End If
End Sub

Le fichier :

11-colonne-sur-3.xlsm (20.19 Ko)

@ bientôt

LouReeD

Le 06/05/2024 à 23:07

Bonsoir à vous deux.

LouReed,

Ton code est sympa, cependant ce n'est pas un tableau structuré mais une table figée qui ne bougera pas. Je vais regarde pour adapter ton code à mon cas.

Pour le Target > 1 en effet je n'avais pas pensé à ce cas. C'est corrigé ainsi:

    'Vérification: Modification d'une seule case à la fois
    With Target
        If .Cells.Count > 1 Then
            MsgBox "N'éditer qu'une cellule à la fois !"
            Application.EnableEvents = False
            .ClearContents
            .Select
            Application.EnableEvents = True
            Exit Sub
        End If
    End With

Merci.

Le 09/05/2024 à 21:37

Bonsoir,

il existe Application.Undo :

Private Sub Worksheet_Change(ByVal Target As Range)
    Dim Plage As Range, CRef As Integer, Temp
    If Target.CountLarge > 1 Then
        MsgBox "N'éditer qu'une cellule à la fois !"
        Application.EnableEvents = False
            Application.Undo
        Application.EnableEvents = True
        Exit Sub
    End If
    Set Plage = Union(Range("Q1:Q23"), Range("S1:S23"), Range("U1:V23"))
    If Not Intersect(Target, Plage) Is Nothing Then
        Application.EnableEvents = False
            Temp = Target
            Union(Cells(Target.Row, 17), Cells(Target.Row, 19), Cells(Target.Row, 21)).Value = vbNullString
            Target.Value = Temp
        Application.EnableEvents = True
    End If
End Sub

Ce qui a le mérite de remettre l'ancienne donnée au cas où... et petite modif du code proposé avant...

@ bientôt

LouReeD

Le 09/05/2024 à 22:13

Bonsoir LouReed,

Effectivement je n'avais pas pensé au Undo, plus avantageux en effet, je garde merci

Rechercher des sujets similaires à "application intersect recupere numero ligne changement"