XL 2019 obliger à remplir une cellule et vider l'autre

matlatarte

XLDnaute Junior
Bonjour, je cherche à obliger l'utilisateur à remplir soit A1 soit A2 mais que si A1 est pleine, A2 soit vide (ou vidé) et que si A2 est pleine A1 soit vide... J'ai un peu regardé en vba mais je m'y perds un peu... Pourriez vous m'éclairer ?

merci
 

fanfan38

XLDnaute Barbatruc
Bonjour
Clic droit sur l'onglet de la feuille concernée
choisir visualiser le code
copier la macro ci dessous
VB:
Private Sub Worksheet_Change(ByVal Target As Range)
If Target.Count > 1 Then Exit Sub
  If Target.Column <> 1 Then Exit Sub
  If Target.Address = "$A$1" And Range("A2").Value <> "" Then Target.Value = ""
  If Target.Address = "$A$2" And Range("A1").Value <> "" Then Target.Value = ""
End Sub
A+ François
 

job75

XLDnaute Barbatruc
Re, salut fanfan38,

Voyez le fichier joint avec dans le code de la feuille :
VB:
Private Sub Worksheet_Change(ByVal Target As Range)
If Application.CountA([A1:A2]) = 2 Then [A1:A2] = ""
ScrollArea = IIf(Application.CountA([A1:A2]) = 1, "", "A1:A2")
End Sub
Et dans ThisWorkbook :
VB:
Private Sub Workbook_Open()
Feuil1.[A1] = Feuil1.[A1] 'lance la macro Worksheet_Change
Saved = True 'évite l'invite à la fermeture si aucune modification
End Sub
Quand la plage A1:A2 est vide on ne peut sélectionner que A1 ou A2.

A+
 

Pièces jointes

  • A1 ou A2(1).xlsm
    14.6 KB · Affichages: 12
Dernière édition:

matlatarte

XLDnaute Junior
merci cela fonctionne sans bug mais même remarque lorsque a1 est rempli, je rempli a2 cela efface tout et il faut reremplir a2 et inversement lorsque a2 est rempli et que je rempli a1 cela efface tout et il faut reremplir a1. Est ce possible d'éviter cela ? soit je rempli a1 et cela efface a2 soit je rempli a2 et cela efface a1. merci !
 

job75

XLDnaute Barbatruc
Fichier (2) avec :
VB:
Private Sub Worksheet_Change(ByVal Target As Range)
If Not Intersect(Target, [A1]) Is Nothing And CStr([A1]) <> "" Then [A2] = ""
If Not Intersect(Target, [A2]) Is Nothing And CStr([A2]) <> "" Then [A1] = ""
ScrollArea = IIf(Application.CountA([A1:A2]) = 1, "", "A1:A2")
End Sub
Bonne nuit.
 

Pièces jointes

  • A1 ou A2(2).xlsm
    15.4 KB · Affichages: 5

Discussions similaires

Statistiques des forums

Discussions
312 215
Messages
2 086 333
Membres
103 188
dernier inscrit
evebar