Empecher double saisie

[gibtoul]

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

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]

Re : Empecher double saisie

Bonjour,
tu peux définir une plage de cellules discontinues en utilisant application.Union :

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

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]

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]

Re : Empecher double saisie

Bonjour,

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

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]

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

 

[gibtoul]

Re : Empecher double saisie

Bonjour

Je reviens vers vous sur la possible résolution de mon petit probleme de double saisie


A bientot

Gibtoul

 

[Dranreb]

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]

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]

Re : Empecher double saisie

Je propose donc :

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]

Re : Empecher double saisie

Dranreb

Je te remercie pour ta réactivité et efficacité, cela correspond à mon besoins.

A bientot

Gibtoul

 

[gibtoul]

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

 

[Dranreb]

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]

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

 

[Dranreb]

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:

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 :

LAutre.Interior.Color = IIf(LAutre.Locked, 0, &HFFFF&)

 

[gibtoul]

Re : Empecher double saisie

bonsoir dranreb,

j'ai essayé d'appliqué les modifications mais sans succès.
je refais un test demain matin

je te tiens au courant

merci encore

a bientôt

gibtoul