Doublons VBA "ID UNIQUE"

Version imprimable

12/02/2020, 12h44
Invité

Doublons VBA "ID UNIQUE"

Bonjour , j'ai un formulaire que je viens de développer ( merci à ce forum ) et j'ai un problème .
En fait , je cherche un code qui me permet de ne pas ajouter une ligne si la colonne "A" (qui est un Id ) est répétée .
et ce code ne doit pas impacter les autres boutons de commande " rechercher " et "fermer" .

1 pièce(s) jointe(s)

Bonjour
à tester :

Code:

1
2
3
4
5
6
7
8
9
10
11
12
Private Sub Worksheet_Change(ByVal Target As Range)
If Not Intersect(Target, Range("A2:A" & Range("A65535").End(xlUp).Row)) Is Nothing Then
COMPARE = Cells(Target.Row, 1)
For i = 2 To Range("A65535").End(xlUp).Row - 1
    If Cells(i, 1) = COMPARE Then
        Cells(Target.Row, 1) = ""
        MsgBox ("Attention, vous avez entré un doublon" & vbLf & "Recommencez la saisie")
        Exit Sub
    End If
Next i
End If
End Sub

12/02/2020, 14h24
Invité

Merci beaucoup Bennaser pour votre réponse rapide .
Le code fonctionne mais un autre problème est toujours là , le code n'efface que la cellule de l'id , je voudrais bien avoir un qui efface toute la ligne , s'il vous plait .

bricolage :aie:
je suis qu'un autodidacte
mais si vous avez 4 colonnes :

Code:

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
Private Sub Worksheet_Change(ByVal Target As Range)
If Not Intersect(Target, Range("A2:A" & Range("A65535").End(xlUp).Row)) Is Nothing Then
COMPARE = Cells(Target.Row, 1)
For i = 2 To Range("A65535").End(xlUp).Row - 1
    If Cells(i, 1) = COMPARE Then
        Cells(Target.Row, 1) = ""
        Cells(Target.Row, 2) = ""
        Cells(Target.Row, 3) = ""
        Cells(Target.Row, 4) = ""
        MsgBox ("Attention, vous avez entré un doublon" & vbLf & "Recommencez la saisie")
        Exit Sub
    End If
Next i
End If
End Sub

12/02/2020, 15h03
Menhir

Code:

Target.EntireRow.ClearContents

@Bennaser , je sais pas pourquoi mais ce code ne marche pas pour moi , il fonctionne comme le précédant ( il ne supprime que la première colonne )
:calim2::calim2::calim2::calim2::calim2::calim2::calim2::calim2:
Code:

1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 Private Sub Worksheet_Change(ByVal Target As Range) If Not Intersect(Target, Range("A2:A" & Range("A65535").End(xlUp).Row)) Is Nothing Then COMPARE = Cells(Target.Row, 1) For i = 2 To Range("A65535").End(xlUp).Row - 1 If Cells(i, 1) = COMPARE Then Cells(Target.Row, 1) = "" Cells(Target.Row, 2) = "" Cells(Target.Row, 3) = "" Cells(Target.Row, 4) = "" MsgBox ("Attention, vous avez entré un doublon" & vbLf & "Recommencez la saisie") Exit Sub End If Next i End If End Sub
Menhir, merci mais ce code je le place après le THEN ?

Code:

Target.EntireRow.ClearContents

Excusez-moi, je suis une débutante :roll:

1 pièce(s) jointe(s)

re
comme à indiqué menhir (bonjour) :

Code:

1
2
3
4
5
6
7
8
9
10
11
12
Private Sub Worksheet_Change(ByVal Target As Range)
If Not Intersect(Target, Range("A2:A" & Range("A65535").End(xlUp).Row)) Is Nothing Then
COMPARE = Cells(Target.Row, 1)
For i = 2 To Range("A65535").End(xlUp).Row - 1
    If Cells(i, 1) = COMPARE Then
    Target.EntireRow.ClearContents
        MsgBox ("Attention, vous avez entré un doublon" & vbLf & "Recommencez la saisie")
        Exit Sub
    End If
Next i
End If
End Sub

mais attention ce n'est pas un code mais plutôt l'évenement worksheet_change
deux clix sur la feuille appropriée et mettre le code
voila un exemple

12/02/2020, 15h43
Invité

Je ne sais pas pourquoi mais j'ai toujours le même problème même en essayant tous ces codes , les autres cellules ne s'effacent pas mais uniquement la première :(
12/02/2020, 15h44
BENNASR

peux tu joindre un fichier test sans données confid??
12/02/2020, 15h44
pijaku

Bonjour,

Attention à plusieurs choses :

1- Range("A65535") est une aberration depuis Excel 2007.

2- boucler sur toutes les lignes de la colonne A systématiquement, à chaque changement dans cette colonne semble démesuré.
Imaginez si la colonne est "bien remplie"...
Le plus simple serait, peut-être :
> déclarer une variable Public de type Collection en entête de module,
> d'alimenter cette collection à l'ouverture du classeur,
> Lors de l'événement Change de la feuille, restreint à la colonne A :
>> tenter d'alimenter la collection avec la nouvelle saisie
>>> Si erreur : message et suppression
>>> Si pas erreur :=> tout bon, on a alimenté notre collection et notre plage!
12/02/2020, 16h03
Patrice740

Bonjour,

Citation:

Envoyé par ElenaEva

Bonjour , j'ai un formulaire que je viens de développer .... .

Par formulaire qu'entends-tu ? Un formulaire VBA (userform) ou une feuille de calcul ?
Si c'est une feuille de calcul, tu pourrais simplement empêcher la saisie de doublon à l'aide d'une validation de donnée (pas besoin de VBA).
12/02/2020, 16h05
Invité

1 pièce(s) jointe(s)

Voilà le fichier est là !!!

1 pièce(s) jointe(s)

re
pourquoi combobox alors et non pas textbox si vous n'autorisez pas un doublons
à tester
supprimer l'evenement worksheet_change
tester ça :

Code:

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
Private Sub CommandButton1_Click()
'doucle click bouton ajouter
Dim F As Worksheet
Set F = Sheets("Feuil1")
If ComboBox1 = "" Then MsgBox ("Code vide")
If TextBox2 = "" Then MsgBox ("Libellé vide")
If TextBox3 = "" Then MsgBox ("Date vide")
If TextBox4 = "" Then MsgBox ("Valeur Vide")
If TextBox5 = "" Then MsgBox ("Quantité vide")
If TextBox6 = "" Then MsgBox ("Fournisseur vide")
   Dim ligne As Long
   Dim plage As Range
 
   COMPARE = ComboBox1.Value
   Set c = F.Columns("A").Find(COMPARE, LookIn:=xlValues, lookat:=xlWhole)
  If Not c Is Nothing Then
   MsgBox ("Attention, vous avez entré un doublon !!!voir ligne numéro :  " & c.Row)
  Exit Sub
  Else
 If MsgBox("confirmez-vous l'ajout des données?", vbYesNo, "confirmation") = vbYes Then
    Worksheets("Feuil1").Select
    ligne = F.Range("A65000").End(xlUp).Row
    ligne = ligne + 1
    Cells(ligne, 1) = ComboBox1.Value
     Cells(ligne, 2) = TextBox2.Value
    Cells(ligne, 3) = TextBox3.Value
    Cells(ligne, 4) = TextBox4.Value
    Cells(ligne, 5) = TextBox5.Value
    Cells(ligne, 6) = TextBox6.Value
 
End If
  End If
      Unload UserForm1
      UserForm1.Show
End Sub

12/02/2020, 17h11
Menhir

Citation:

Envoyé par ElenaEva

Menhir , merci mais ce code je le place après le THEN ?

Quel est le message d'erreur ?

1 pièce(s) jointe(s)

Pour ma réponse si haut je propose d’empêcher l'enregistrement en cas de doublons mais si vous insister à enregistrer et si c'est doublons donc effacer alors il suffit d'enregistrer qu'au dernier moment l'ID
car si en enregistre l'id en colonne A à ce moment l’événement worksheets_change se déclenche avant l'envoie des autre textbox

Code:

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
Private Sub CommandButton1_Click()
'doucle click bouton ajouter
 
 
 
If ComboBox1 = "" Then MsgBox ("Code vide")
 
If TextBox2 = "" Then MsgBox ("Libellé vide")
If TextBox3 = "" Then MsgBox ("Date vide")
If TextBox4 = "" Then MsgBox ("Valeur Vide")
If TextBox5 = "" Then MsgBox ("Quantité vide")
If TextBox6 = "" Then MsgBox ("Fournisseur vide")
 
 
    Dim ligne As Integer
    If MsgBox("confirmez-vous l'ajout des données?", vbYesNo, "confirmation") = vbYes Then
    Worksheets("Feuil1").Select
    ligne = Range("B65000").End(xlUp).Row
    ligne = ligne + 1
 
     Cells(ligne, 2) = TextBox2.Value
    Cells(ligne, 3) = TextBox3.Value
    Cells(ligne, 4) = TextBox4.Value
    Cells(ligne, 5) = TextBox5.Value
    Cells(ligne, 6) = TextBox6.Value
     Cells(ligne, 1) = ComboBox1.Value 'juste cette partie qui déclenche l’événement est mise en dernier lieu
 
      Unload UserForm1
      UserForm1.Show
    Else
    End If
 
 
 
End Su

13/02/2020, 08h58
Invité

MERCI BENNASER , VOTRE SUGGESTION FONCTIONNE A MERVEILLE .
MERCI ÉNORMÉMENT ENCORE . C'EST RÉSOLU:D:D:D

MEERCI AUX AUTRES AUSSI POUR VOTRE FEED : MENHIR , PIKAJU , PATRICE740 . :D