Microsoft 365 VBA Efface une cellule si une autre est modifiée

Benoit84 · 3 Juin 2020

Bonjour

J'ai un code ci-dessous pour effacer une cellule si une autre est modifiée.
Mon besoin est de pouvoir utiliser une autre formule plus simplifier pour dire que si je saisie en cellule B8 j'efface le contenu de la cellule en Colonne -1 soit A8,
si je saisie en cellule A8 j'efface le contenu de la cellule en Colonne +1 soit B8.

Avec mon code ci-dessous ça marche mais cela nécessiterais que je le copie autant de fois que j'ai de cellules, or j'ai 2 zones avec 40 lignes.

Quelqu'un aurait-il la solution de simplification ?

Merci d'avance, ci joint mon fichier test.
_______________________________________________________________________________________________________________
Public Flag As Boolean
Private Sub Worksheet_Change(ByVal Target As Range)

If Flag Then Exit Sub

If Not Application.Intersect(Target, Range("a8")) Is Nothing Then
Flag = True
Range("b8").ClearContents
Range("a9").Select
Flag = False
End If
If Not Application.Intersect(Target, Range("b8")) Is Nothing Then
Flag = True
Range("a8").ClearContents
Range("b9").Select
Flag = False
End If
'------------------------------------------------------------------------
'------------------------------------------------------------------------
If Flag Then Exit Sub

If Not Application.Intersect(Target, Range("b9")) Is Nothing Then
Flag = True
Range("a9").ClearContents
Range("b10").Select
Flag = False
End If
If Not Application.Intersect(Target, Range("a9")) Is Nothing Then
Flag = True
Range("b9").ClearContents
Range("a10").Select
Flag = False
End If
'------------------------------------------------------------------------

End Sub
_______________________________________________________________________________________________________________

M12 · 3 Juin 2020

Bonjour
Teste comme ceci

VB:

Public Flag As Boolean
Private Sub Worksheet_Change(ByVal Target As Range)
        If Flag Then Exit Sub
        If Not Application.Intersect(Target, Range("a8:a17")) Is Nothing Then
                Flag = True
                Target.Offset(0, 1).ClearContents
                Target.Offset(1, 0).Select
                Flag = False
        End If
        If Not Application.Intersect(Target, Range("a23:a35")) Is Nothing Then
                Flag = True
                Target.Offset(0, 1).ClearContents
                Target.Offset(1, 0).Select
                Flag = False
        End If
    
    '------------------------------------------------------------------------
    '------------------------------------------------------------------------
        If Flag Then Exit Sub
        If Not Application.Intersect(Target, Range("b8:b17")) Is Nothing Then
                Flag = True
                Target.Offset(0, -1).ClearContents
                Target.Offset(1, 0).Select
                Flag = False
        End If
        If Not Application.Intersect(Target, Range("b23:b35")) Is Nothing Then
                Flag = True
                Target.Offset(0, -1).ClearContents
                Target.Offset(1, 0).Select
                Flag = False
        End If
    '------------------------------------------------------------------------

End Sub

patricktoulon · 3 Juin 2020

Bonjour
les choses sont beaucoup plus simple que cela
te reste a faire les delimitation d'action en terme de ligne et ou colonne
utiliser une flag c'est pas top tu a le bloqueur d’événement pour ca

VB:

Private Sub Worksheet_Change(ByVal Target As Range)
   Dim FirstLigne&
    FirstLigne = 1 ' ligne a partir  la quelle l'evenement doit agir
   
    If Target.Row >= FirstLigne And Target.Count = 1 Then

        Select Case Target.Column

        Case 1: If Target <> "" Then Application.EnableEvents = False: Target.Offset(, 1) = "" ' colonne"A"

        Case 2: If Target(1) <> "" Then Application.EnableEvents = False: Target.Offset(, -1) = "" ' colonne"B"

        End Select
    End If
    Application.EnableEvents = True
End Sub

patricktoulon · 3 Juin 2020

et si je reprends l'idée de M12 que je salut ca donne cela
tout simplement

VB:

Private Sub Worksheet_Change(ByVal Target As Range)
  If Not Application.Intersect(Target, Range("A8:b17")) Is Nothing Then
        Select Case Target.Column
        Case 1: If Target <> "" Then Application.EnableEvents = False: Target.Offset(, 1) = "" ' colonne"A"

        Case 2: If Target(1) <> "" Then Application.EnableEvents = False: Target.Offset(, -1) = "" ' colonne"B"

        End Select
    End If
    Application.EnableEvents = True
End Sub

bien sur dans le même tu peux gerer x plage sur les mêmes colonnes même non contiguës

VB:

If Not Application.Intersect(Target, Range("A8:b17,A33:B55")) Is Nothing Then

Benoit84 · 3 Juin 2020

Bonjour
Merci à tous les 2 pour votre aide.
c'est vraiment simplifié, au top du top.

Pensez-vous que je peux rajouter une condition pour dire que si il y a une sélection de plusieurs colonnes cela soit ignoré par la macro ?
Quand j'efface une sélection de a8 à a13 il plante sur le case 1: et je voudrais éviter ce bug

Merci

Benoit84 · 3 Juin 2020

au final j'ai mis ce code et ça fonctionne

If Selection.Count > 1 Then Exit Sub

patricktoulon · 3 Juin 2020

re
non c'est
if target.count> then exit sub

Benoit84 · 4 Juin 2020

Bonjour
oui effectivement c'est plus adapté merci encore

Microsoft 365 VBA Efface une cellule si une autre est modifiée

Benoit84

XLDnaute Nouveau

Pièces jointes

M12

XLDnaute Accro

patricktoulon

XLDnaute Barbatruc

patricktoulon

XLDnaute Barbatruc

Benoit84

XLDnaute Nouveau

Benoit84

XLDnaute Nouveau

patricktoulon

XLDnaute Barbatruc

Benoit84

XLDnaute Nouveau

Discussions similaires