Empecher double saisie

gibtoul

XLDnaute Junior
Bonjour à Tous

j'ai récuperé le code suivant pour eviter d'avoir sur les colonnes AS et AT une double saisie sur les celllules d'une meme ligne.

Je souhaiterais appliquer cela à plusieurs autre colonne : C et F , X et Z. ...;

Après plusieurs tentatives sans succès je fais appel au forum pour m'aider !!

Merci

A bientot

Gibtoul







Code:
Private Sub Worksheet_Change(ByVal zz As Range)
If Intersect(zz, Range("AS80:AT633")) Is Nothing Then Exit Sub
y = zz.Row
If Application.CountA(Range("AS" & y & ":AT" & y)) > 1 Then
Application.EnableEvents = False
MsgBox "Attention double saisie !!": zz = ""
Application.EnableEvents = True
End If
End Sub
 

david84

XLDnaute Barbatruc
Re : Empecher double saisie

Bonjour,
tu peux définir une plage de cellules discontinues en utilisant application.Union :
Code:
Dim MaPlage as Range
Set MaPlage=Application.Union(Range("C80:C633"),Range("T80:T633"),Range("AS80:AT633"))
et utiliser ensuite la plage MaPlage dans la suite de ton code, par exemple
Code:
If Intersect(zz, MaPlage) Is Nothing Then Exit Sub
Suite du code à adapter.
Code non testé mais je t'expose l'idée.
A+
 

gibtoul

XLDnaute Junior
Re : Empecher double saisie

Bonjour David84

Je te remercie pour ta réponse.

J'ai modifié le code de la facon suivante mais sans succès (je suis pas vraiment un expert ...)

as tu la possibilité de m'aiguiller

merci pour ton aide

a+


Private Sub Worksheet_Change(ByVal zz As Range)
If Intersect(zz, MaPlage) Is Nothing Then Exit Sub
y = zz.Row
Dim MaPlage As Range
Set MaPlage = Application.Union(Range("C80:C633"), Range("T80:T633"), Range("AS80:AT633"))
Application.EnableEvents = False
MsgBox "Attention double saisie !!": zz = ""
Application.EnableEvents = True
End If
End Sub
 

Pierrot93

XLDnaute Barbatruc
Re : Empecher double saisie

Bonjour,

En l'absence de David:), que je salue au passage, initialise la variable avant d'effectuer le test :

Code:
Private Sub Worksheet_Change(ByVal zz As Range)
Dim MaPlage As Range
Set MaPlage = Application.Union(Range("C80:C633"), Range("T80:T633"), Range("AS80:AT633"))
If Intersect(zz, MaPlage) Is Nothing Then Exit Sub
bonne journée
@+
 

gibtoul

XLDnaute Junior
Re : Empecher double saisie

Bonjour Pierrot

Merci pour ta réponse.

J'ai joins le fichier test car je bute pour la résolution. ... et puis je suis pas très clair dans mes explications.

Mon besoin est de ne pas pouvoir saisir sur une même ligne dans les colonne C et T
et avoir la meme possibilité sur les colonne AS et AT

les deux plages étant independantes

Le fichier test2 comporte le code initiale fonctionnant pour les plages AS et AT

Merci pour votre aide

Gibtoul
 

Pièces jointes

  • Test.xlsm
    22.2 KB · Affichages: 46
  • Test.xlsm
    22.2 KB · Affichages: 53
  • Test.xlsm
    22.2 KB · Affichages: 45
  • Capture.jpg
    Capture.jpg
    33.1 KB · Affichages: 75
  • Test2.xlsm
    22.3 KB · Affichages: 60
  • Capture.jpg
    Capture.jpg
    33.1 KB · Affichages: 71
  • Test2.xlsm
    22.3 KB · Affichages: 59
  • Capture.jpg
    Capture.jpg
    33.1 KB · Affichages: 69
  • Test2.xlsm
    22.3 KB · Affichages: 61
Dernière édition:

Dranreb

XLDnaute Barbatruc
Re : Empecher double saisie

Bonjour.
Ce que je ne comprends pas bien c'est pourquoi on n'empêche pas la saisie plutôt que de la sanctionner.
Donc en corrigeant la sélection d'une cellule au profit de celle qui est renseignée puisqu'il faudrait donc d'abord l'effacer ?
 

gibtoul

XLDnaute Junior
Re : Empecher double saisie

bonjour Dranreb,

Effectivement cela peux etre la solution puisque l'objectif est qu'au final qu'une seule cellule soit renseignée sur une meme ligne et par rapport à 2 colonnes. Ca marche bien avec la macro du fichier test mais je n'arrive pas à la modifié pour avoir la meme fonctionalité sur un autre groupe de 2 colonnes
 

Dranreb

XLDnaute Barbatruc
Re : Empecher double saisie

Je propose donc :
VB:
Private Sub Worksheet_SelectionChange(ByVal Target As Range)
Dim I As Long, LAutre As Range
If Target.Count <> 1 Then Exit Sub
If Intersect(Me.[80:633], Target) Is Nothing Then Exit Sub
For I = 0 To 3
   If Not Intersect(Me.Columns(Array("C", "T", "AS", "AT")(I)), Target) Is Nothing Then
      Set LAutre = Intersect(Me.Columns(Array("T", "C", "AT", "AS")(I)), Target.EntireRow)
      If Not IsEmpty(LAutre.Value) Then
         Application.EnableEvents = False
         LAutre.Select
         Application.EnableEvents = True: End If
      Exit Sub: End If
   Next I
End Sub
 

gibtoul

XLDnaute Junior
Re : Empecher double saisie

Bonjour

je reviens sur le code sur lequel ,si cela est possible , avoir une amelioration.

Pour ma saisie sur une ligne et me deplacer de cellule en cellule , j'utilise les fleches du pavé gauche ou droite
Mais lorsque une saisie est faite sur une celulle ou je restreins la saisie je suis bloqué dans mon defilement
Est -il possible, lors d'un deplacement avec les fleches et lors d'un bloquage, de passer à la cellule suivante

je joins le fichiers exemple ou par exemple je suis bloqué sur la ligne 5 entre les colonnes D te S

Merci pour votre aide

a+
gibtoul
 

Pièces jointes

  • Essai1.xlsm
    15.7 KB · Affichages: 41
  • Essai1.xlsm
    15.7 KB · Affichages: 38
  • Essai1.xlsm
    15.7 KB · Affichages: 41

Dranreb

XLDnaute Barbatruc
Re : Empecher double saisie

Bonjour.
Je ne vois pas trop comment faire.
À moins qu'il ne soit en fin de compte pas très utile d'être renvoyé sur la cellule qui doit être modifiée d'abord, et qu'on peut, à la place se contenter d'une impossibilité de sélectionner la cellule vide si l'autre est renseignée.
Dans ce cas c'est facile: protégez la feuille sans mot de passe mais après avoir déverrouillé toute ses cellules de sorte que ce soit à peu près sans effet. Dans une Worksheet_Change à peut près écrite comme la Worksheet_SelectionChange au lieu de
LAutre.Select mettez LAutre.Locked = Not IsEmpty(Target.Value)
 

gibtoul

XLDnaute Junior
Re : Empecher double saisie

Bonjour Dranbeb

J'ai modifié le code , protegé la feuille en deverouillant les cellules concernées mais la saisie est rendu possible

Je joins le fichier modifié

a+

gibtoul
 

Pièces jointes

  • Essai2.xlsm
    16.8 KB · Affichages: 41
  • Essai2.xlsm
    16.8 KB · Affichages: 43
  • Essai2.xlsm
    16.8 KB · Affichages: 44

Dranreb

XLDnaute Barbatruc
Re : Empecher double saisie

Bonjour
Vous avez laissé le code dans une Worksheet_SelectionChange au lieu de le mettre dans une Worksheet_Change.
C'est désormais lorsqu'une cellule change qu'il faut changer LAutre.Locked. Et en principe LAutre est vide alors, inutile de le tester.
Mais je vous accorde que ce n'est pas facile à mettre au point.
Déjà parce que la protection va empêcher de le faire. Alors il faut d'abord ôter la protection puis la remettre après. Ou alors la refaire à l'ouverture du classeur (Workbook_Open) mais avec le paramètre UserInterfaceOnly:=True

Et verrouillez déjà au départ celles dont l'autre est renseignée.

Essayez comme ça:
VB:
Private Sub Worksheet_Activate()
Me.Protect Scenarios:=False, UserInterfaceOnly:=True, _
   AllowFormattingCells:=True, AllowFormattingColumns:=True, AllowFormattingRows:=True, _
   AllowInsertingRows:=True, AllowInsertingHyperlinks:=True, AllowDeletingRows:=True, _
   AllowSorting:=True, AllowFiltering:=True, AllowUsingPivotTables:=True
Me.EnableSelection = xlUnlockedCel
End Sub

Private Sub Worksheet_Change(ByVal Target As Range)
Dim I As Long, LAutre As Range
If Target.Count <> 1 Then Exit Sub
If Intersect(Me.[3:10], Target) Is Nothing Then Exit Sub
For I = 0 To 3
   If Not Intersect(Me.Columns(Array("C", "T", "V", "W")(I)), Target) Is Nothing Then
      Set LAutre = Intersect(Me.Columns(Array("T", "C", "W", "V")(I)), Target.EntireRow)
      LAutre.Locked = Not IsEmpty(Target.Value)
      Exit Sub: End If
   Next I
On pourrait même ajouter derrière la modification de LAutre.Locked :
VB:
LAutre.Interior.Color = IIf(LAutre.Locked, 0, &HFFFF&)
 
Dernière édition: