DOUBLON lors de saisie

[GHISLAIN]

bonjour le forum

je viens de recuperer un code sur le site concernant l'interdiction de la saisie lors de doublon.
Je ne parviens pas a le mettre en application sur mon projet .
effectivement le code me prend en compte la saisie de doublon et me l'efface .

toutefois lors d'un enregistrement unique il me le considere comme un doublon et du coup je ne peux plus rien saisir.

merci a tous de jeter un oeil sur l exemple ci joint


amicalement

ghislain

 

[skoobi]

Re : DOUBLON lors de saisie

Bonjour,

je te propose ce code:

Private Sub Worksheet_Change(ByVal Target As Excel.Range)
  Dim Ref As String
  Dim Cell As Range, Plage As Range
  If Application.Intersect(Target, Range("C7:AP43")) Is Nothing Or IsEmpty(Target.Value) Then Exit Sub
  Ref = Target.Value
  Set Plage = Range("C7:AP43")
  If Application.WorksheetFunction.CountIf(Plage, Ref) > 1 Then
    Set Cell = Plage.Find(Ref, Target, xlValues, xlWhole)
    MsgBox "N° échantillon déjà saisie " & Cell.Address, vbCritical, "DOUBLON"
    Target.Activate
    Target.ClearContents
  End If
End Sub

 

[GHISLAIN]

Re : DOUBLON lors de saisie

bonjour SKOOBI,

deja je te remercie d'etre passé sur mon fil et de m'avoir proposé une solution

je viens juste d'utiliser ton code qui fonctionne a merveille.

dans la continuité j'aurai voulu savoir je peux completer ce code qui tienne compte de la ligne 6 independement des autres , je voudrai controler l'interdiction de la saisie des doublon uniquement sur cette ligne.
j ai tenté de garder le meme code en modifiant juste les déclarations mais sans succés.

Dim Ref1 As String
Dim Cell1 As Range, Plage1 As Range
If Application.Intersect(Target, Range("C6:AP6")) Is Nothing Or IsEmpty(Target.Value) Then Exit Sub
Ref1 = Target.Value
Set Plage1 = Range("C6:AP6")
If Application.WorksheetFunction.CountIf(Plage, Ref1) > 1 Then
Set Cell1 = Plage1.Find(Ref1, Target, xlValues, xlWhole)
MsgBox "NUMERO DE SERIE DEJA UTILISE :" & Target.Value & " EN CELLULE :" & Cell.Address, vbCritical, "DOUBLON"
Target.Activate
Target.ClearContents
End If

je te remercie de l'aide apporté e

amicalement

GHISLAIN

 

[GHISLAIN]

Re : DOUBLON lors de saisie

re

je viens de m'appercevoir que si je selectionne plusieurs cellule pour effacer le contenu j ai un message d'erreur execution 13 incompatibilité de type.

j'ai mis on error resume next qui m'enleve le message mais le temps d'execution deviens tres long

merci encore de votre aide


amicalement ghislain

 

[skoobi]

Re : DOUBLON lors de saisie

Re bonjour,

Voici les modifications (en bleu pour gérer la sélection unique)
Pour la nouvelle plage, tu as justes oublié de préciser "1" à plage 😉:

Private Sub Worksheet_SelectionChange(ByVal Target As Range)
  Dim Ref1 As String
  Dim Cell1 As Range, Plage1 As Range
  If Application.Intersect(Target, Range("C6:AP6")) Is Nothing Or IsEmpty(Target.Value) Then Exit Sub
[B][COLOR=blue]  If Target.Count = 1 Then[/COLOR][/B]
    Ref1 = Target.Value
    Set Plage1 = Range("C6:AP6")
    If Application.WorksheetFunction.CountIf(Plage[SIZE=4][B]1[/B][/SIZE], Ref1) > 1 Then
      Set Cell1 = Plage1.Find(Ref1, Target, xlValues, xlWhole)
      MsgBox "NUMERO DE SERIE DEJA UTILISE :" & Target.Value & " EN CELLULE :" & Cell.Address, vbCritical, "DOUBLON"
      Target.Activate
      Target.ClearContents
    End If
[B][COLOR=blue]  End If[/COLOR][/B]
End Sub

Bonne journée.

 

[GHISLAIN]

Re : DOUBLON lors de saisie

re skoobi

concernant la gestion des cellules multiple j'ai mis ce code pour l'interdire ce qui empeche l'effecement de plusieurs cellules a la fois

If Selection.Cells.Count > 1 Then
MsgBox "VOUS NE POUVEZ PAS SELECTIONNER PLUSIEURS CELLULES", vbCritical, "RESTRICTION"
ActiveCell.Select
Exit Sub
End If


pour gerer la ligne 6 pour les doublons je n y parviens pas , j'aurais souhaité que cette gestion se face independement de la plage C7:AP43
If Application.Intersect(Target, Range("C7:AP43")) Is Nothing Or IsEmpty(Target.Value) Then Exit Sub

j ai tenté de mettre ce meme code dans le module en mettant
If Application.Intersect(Target, Range("C6:AP6")) Is Nothing Or IsEmpty(Target.Value) Then Exit Sub
mais rien a faire il n'en tient pas compte

je vais donc intégrer cette ligne 6 dans le premier code
If Application.Intersect(Target, Range("C6:AP43")) Is Nothing Or IsEmpty(Target.Value) Then Exit Sub

merci encore de ton aide

amicalement ghislain

 

[skoobi]

Re : DOUBLON lors de saisie

Re,

tu peux essayer comme ceci (ne pas oublier les parenthèses pour bien "isoler" le And):

If [SIZE=3][COLOR=blue][B]([/B][/COLOR][/SIZE]Application.Intersect(Target, Range("C7:AP43")) Is Nothing And Application.Intersect(Target, Range("C6:AP6")) Is Nothing[B][SIZE=3][COLOR=blue])[/COLOR][/SIZE][/B] _
Or IsEmpty(Target.Value) Then Exit Sub

 

[skoobi]

Re : DOUBLON lors de saisie

Plus court:

If Application.Intersect(Target, Union([C7:AP43], [C6:AP6])) Is Nothing _
Or IsEmpty(Target.Value) Then Exit Sub