Discussion :

[patleter]

Bonjour,
tres débutant en vba, j'ai un problème de doublon!!!!

je crée une table par l'intermédiaire d'un Useform. chaque enregistrement est doté d'un code.
je souhaite lors de la validation des données de l'Userform pouvoir arrêter la procédure d'enregistrement si le numéro est déjà crée. j'ai le code suivant dans le bouton ajout

jusque la pas de problème

j'ai ajouté, dans le worksheet de la feuille ou les données sont a comparer, le code mis en ligne par Frédéric Sigonneau sur un scénario de Sitting hoax Laurent D (de Marseille)

Lors de la saisie le doublon est bien reperé

mais ,ou cela se gate, c'est apres la validation de la msgbox, la copie de tous les champs se fait sans la valeur du code qui est effacé.

Ce que je souhaiterai , c'est qu'après la détection du doublon le curseur se replace dans le Textbox_code
et attende la saisie d'un nouveau code avant de procéder aux enregistrements.

voici les codes

merci de m'aider

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

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
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
Private Sub btn_lot_ajou_Click()
 
If Text_lot_num.Value = "" Then
Select Case MsgBox("Vous devez ABSOLUMENT attribuer un numéro de lot", vbYesNo, "Titre de la MsgBox")
    Case vbYes
        'procédure si click sur Oui
         Text_lot_num.Value = ""
         Text_lot_num.SetFocus
    Case vbNo
          Use_lot.Hide
End Select
 
 
Else
 
' selectionne la feuille lots
Sheets("Lots").Select
'routine sur l'inscription des valeurs dans la ligne premiere vide
ligne = 2
Range("A" & ligne).Select
Do While Range("A" & ligne).Value <> ""
    ligne = ligne + 1
Loop
' copie les valeurs des zones de saisie dans la feuille lots
Range("A" & ligne).Value = Text_lot_num.Value
Range("B" & ligne).Value = Text_lot_bai.Value
Range("C" & ligne).Value = Text_lot_loc.Value
Range("D" & ligne).Value = Text_lot_adr.Value
Range("E" & ligne).Value = Text_lot_cod.Value
Range("F" & ligne).Value = Comb_lot_com.Value
Range("G" & ligne).Value = Text_lot_tel.Value
Range("H" & ligne).Value = Text_lot_fax.Value
Range("I" & ligne).Value = Text_lot_por.Value
Range("J" & ligne).Value = Text_lot_mel.Value
Range("K" & ligne).Value = Text_lot_comm.Value
' remet les valeurs des zones de saisie a vide
Text_lot_num.Value = ""
Text_lot_bai.Value = ""
Text_lot_loc.Value = ""
Text_lot_adr.Value = ""
Text_lot_cod.Value = ""
Comb_lot_com.Value = ""
Text_lot_tel.Value = ""
Text_lot_fax.Value = ""
Text_lot_por.Value = ""
Text_lot_mel.Value = ""
Text_lot_comm.Value = ""
'remet le curseur dans la zone choisie
Text_lot_num.SetFocus
  ' trie et dedoublonne la colonne c ( communes) et la colonne E (locataires)
 ' tri
  worksheets("Listes").Select
  Columns("c:c").Select
    ActiveSheet.Range("$c$1:$c$5000").RemoveDuplicates Columns:=1, Header:=xlYes
  ' dedoublonnage
     Range("c2:c50000").Select
    ActiveWorkbook.worksheets("Listes").Sort.SortFields.Clear
    ActiveWorkbook.worksheets("Listes").Sort.SortFields.Add Key:=Range("c2:c5000") _
        , SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal
    With ActiveWorkbook.worksheets("Listes").Sort
        .SetRange Range("c2:c5000")
        .Header = xlGuess
        .MatchCase = False
        .Orientation = xlTopToBottom
        .SortMethod = xlPinYin
        .Apply
    End With
        ' tri
 worksheets("Listes").Select
 Columns("e:e").Select
    ActiveSheet.Range("$e$1:$e$5000").RemoveDuplicates Columns:=1, Header:=xlYes
   ' dedoublonnage
     Range("e2:e50000").Select
    ActiveWorkbook.worksheets("Listes").Sort.SortFields.Clear
    ActiveWorkbook.worksheets("Listes").Sort.SortFields.Add Key:=Range("e2:e5000") _
        , SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal
    With ActiveWorkbook.worksheets("Listes").Sort
        .SetRange Range("e2:e5000")
        .Header = xlGuess
        .MatchCase = False
        .Orientation = xlTopToBottom
        .SortMethod = xlPinYin
        .Apply
    End With
 
'tri de la table des lots
    worksheets("Lots").Select
    Application.Goto Reference:="TableLots"
  ActiveWorkbook.worksheets("Lots").Sort.SortFields.Clear
    ActiveWorkbook.worksheets("Lots").Sort.SortFields.Add Key:=Range("A2:A5000"), _
        SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal
    With ActiveWorkbook.worksheets("Lots").Sort
        .SetRange Range("A2:K5000")
        .Header = xlGuess
        .MatchCase = False
        .Orientation = xlTopToBottom
        .SortMethod = xlPinYin
        .Apply
    End With
    ActiveWorkbook.Save
    Sheets("accueil").Select
 
 
 End If
End Sub
 
 
Private Sub Worksheet_Change(ByVal Target As Range)
 
If Target.Value = "" Then Exit Sub
 
For Each Cell In Intersect(UsedRange, Cells)
If Cell.Address <> Target.Address And Cell.Value = Target.Value Then
MsgBox "saisissez un autre numéro, celui-ci existe déjà"
Target.Value = ""
Target.Select
Exit For
End If
Next Cell
Target.Value = ""
worksheets("Lots").Select
 
End Sub

[ouskel'n'or]

Bonsoir, Bienvenue sur le forum.

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
Private Sub btn_lot_ajou_Click()
If Text_lot_num.Value = "" Then
     Msgbox ("Vous devez ABSOLUMENT attribuer un numéro de lot",vbok, "SAISIE NUMERO DE LOT")
      Text_lot_num.SetFocus
      Exit sub
    Else
      'La suite

Comme il s'agit d'une information impérative ton select case ne sert à rien.
A moins que tu souhaites traiter un champ vide par une fermeture de l'USF
Tu dis

Si tu veux fermer l'usf si la personne veut abandonner, alors utilise le msgbox ainsi

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
     If Text_lot_num.Value = "" Then
           if MsgBox("Vous devez ABSOLUMENT attribuer un numéro de lot", vbYesNo, "Titre de la MsgBox") = vbYes then
                'procédure si click sur Oui
                Text_lot_num.SetFocus
                Exit sub
             else
                Use_lot.Hide
           endif
        else
            'la suite de ton code

J'ai corrigé une erreur dans le code précédent

[patleter]

cette partie du code fonctionne a merveille.
par contre pour la suite j' ai encore besoin de votre aide

lors de l'ajout
apres l'episode = ""
je souhaiterai que si le numéro en text_lot_num est un doublon par rapport a une liste colonne A:A
1 - j'ai un message qui me signale un doublon

2 - que lorsque je clik sur le ok du msgbox je retrouve l'userform ,textbox remis a "", et que le reste du programme s"arrete tant que la nouvelle valeur n'est pas rentrée

avec le code de la feuille j'arrive bien a détecter le doublon mais quand je clik le programme ne s'arrete pas et lance toute les opérations de copy

je vous remet le code de la feuille:

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
Private Sub Worksheet_Change(ByVal Target As Range)
 
If Target.Value = "" Then Exit Sub
 
For Each Cell In Intersect(UsedRange, Cells)
If Cell.Address <> Target.Address And Cell.Value = Target.Value Then
MsgBox "saisissez un autre numéro, celui-ci existe déjà"
Target.Value = ""
Target.Select
Exit For
End If
Next Cell
Target.Value = ""
worksheets("Lots").Select
 
 
 
End Sub

merci

[ouskel'n'or]

Pourquoi ne mets-tu pas le test à la suite du précédent ?
Précise tout de même si le code doit être numérique ou alphanumérique ou alphabétique.
S'il est alphabétique ou alphanumérique, il faut penser que ton test, tel qu'il est écrit, différencie majuscule et minuscule.
Je te propose d'utiliser Find (un coup d'eil dans l'aide t'en dira plus)
Je reprends ce code.

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

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
Private Sub btn_lot_ajou_Click()
Dim c as range, derlig as long
     If Text_lot_num.Value = "" Then
           if MsgBox("Vous devez ABSOLUMENT attribuer un numéro de lot", vbYesNo, "Titre de la MsgBox") = vbYes then
                'procédure si click sur Oui
                Text_lot_num.SetFocus
                Exit sub
             else
                Use_lot.Hide
           endif
        else 'si c'est un numérique, tu peux le vérifier ici et ajouter une condition
           'On cherche la valeur dans la colonne A
           Sheets("Lots").activate
           Derlig = Split(ActiveSheet.UsedRange.Address, "$")(4)
           With Sheets("Lots").Range("a1:a" & Derlig)
                Set c = .Find(Text_lot_num.Value, lookin:=xlValues)
                'Si elle existe, on efface Text_lot_num et on replace le focus 
                If Not c Is Nothing Then
                     Msgbox "code existant, on fait quoi ?"
                     Me.Text_lot_num = ""
                     Me.Text_lot_num.setfocus
                     exit sub
                End If
           End With
     endif
End sub

Et supprime la macro "Private Sub Worksheet_Change(ByVal Target As Range)"
Ce n'est pas une méthode appropriée ici.
Tu dis
A+

Edit
Je pense à un pb qui peut se présenter : Si un code, n'importe lequel, peut être contenu dans un autre code, alors tu dois ajouter dans find l'argument Lookat:=xlwhole qui voudra dire que tu cherches une valeur correspondant à la totalité de la cellule, et non un bout.

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

Set c = .Find(Text_lot_num.Value, lookin:=xlValues, Lookat:=xlwhole)

Si la casse a de l'importance (majuscule <> minuscule) alors tu dois encore ajouter MatchCase:=True

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

Set c = .Find(Text_lot_num.Value, lookin:=xlValues, Lookat:=xlwhole, MatchCase:=True)

Etc.

[patleter]

je te suis reconnaissant
la sub marche parfaitement

j'ai un peu galérer avec les else et end if

je t'avoue ne pas avoir tout compris mais tu m'as fait progresser

c'est vraiment super.

a bientot car je crois que j'aurai encore besoin de tes services

merci

je joint le code final pour en aider d'autres:

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

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
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
Private Sub btn_lot_ajou_Click()
          Dim c As Range, derlig As Long
     If Text_lot_num.Value = "" Then
           If MsgBox("Vous devez ABSOLUMENT attribuer un Numéro de Lot", vbYesNo, "Titre de la MsgBox") = vbYes Then
                'procédure si click sur Oui
                Text_lot_num.SetFocus
                Exit Sub
             Else
                Use_lot.Hide
           End If
        Else 'si c'est un numérique, tu peux le vérifier ici et ajouter une condition
           'On cherche la valeur dans la colonne A
           Sheets("Lots").Activate
           derlig = Split(ActiveSheet.UsedRange.Address, "$")(4)
           With Sheets("Lots").Range("a1:a" & derlig)
                Set c = .Find(Text_lot_num.Value, LookIn:=xlValues, Lookat:=xlWhole)
                'Si elle existe, on efface Text_lot_num et on replace le focus
                If Not c Is Nothing Then
                     MsgBox "Code déjà existant, Veuillez resaisir un autre Code.  Merci"
                     Me.Text_lot_num = ""
                     Me.Text_lot_num.SetFocus
                     Exit Sub
                End If
        End With
     End If
' selectionne la feuille lots
Sheets("Lots").Select
'routine sur l'inscription des valeurs dans la ligne premiere vide
ligne = 2
Range("A" & ligne).Select
Do While Range("A" & ligne).Value <> ""
    ligne = ligne + 1
Loop
' copie les valeurs des zones de saisie dans la feuille lots
Range("A" & ligne).Value = Text_lot_num.Value
Range("B" & ligne).Value = Text_lot_bai.Value
Range("C" & ligne).Value = Text_lot_loc.Value
Range("D" & ligne).Value = Text_lot_adr.Value
Range("E" & ligne).Value = Text_lot_cod.Value
Range("F" & ligne).Value = Comb_lot_com.Value
Range("G" & ligne).Value = Text_lot_tel.Value
Range("H" & ligne).Value = Text_lot_fax.Value
Range("I" & ligne).Value = Text_lot_por.Value
Range("J" & ligne).Value = Text_lot_mel.Value
Range("K" & ligne).Value = Text_lot_comm.Value
' remet les valeurs des zones de saisie a vide
Text_lot_num.Value = ""
Text_lot_bai.Value = ""
Text_lot_loc.Value = ""
Text_lot_adr.Value = ""
Text_lot_cod.Value = ""
Comb_lot_com.Value = ""
Text_lot_tel.Value = ""
Text_lot_fax.Value = ""
Text_lot_por.Value = ""
Text_lot_mel.Value = ""
Text_lot_comm.Value = ""
'remet le curseur dans la zone choisie
Text_lot_num.SetFocus
  ' trie et dedoublonne la colonne c ( communes) et la colonne E (locataires)
 ' tri
  worksheets("Listes").Select
  Columns("c:c").Select
    ActiveSheet.Range("$c$1:$c$5000").RemoveDuplicates Columns:=1, Header:=xlYes
  ' dedoublonnage
     Range("c2:c50000").Select
    ActiveWorkbook.worksheets("Listes").Sort.SortFields.Clear
    ActiveWorkbook.worksheets("Listes").Sort.SortFields.Add Key:=Range("c2:c5000") _
        , SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal
    With ActiveWorkbook.worksheets("Listes").Sort
        .SetRange Range("c2:c5000")
        .Header = xlGuess
        .MatchCase = False
        .Orientation = xlTopToBottom
        .SortMethod = xlPinYin
        .Apply
    End With
        ' tri
 worksheets("Listes").Select
 Columns("e:e").Select
    ActiveSheet.Range("$e$1:$e$5000").RemoveDuplicates Columns:=1, Header:=xlYes
   ' dedoublonnage
     Range("e2:e50000").Select
    ActiveWorkbook.worksheets("Listes").Sort.SortFields.Clear
    ActiveWorkbook.worksheets("Listes").Sort.SortFields.Add Key:=Range("e2:e5000") _
        , SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal
    With ActiveWorkbook.worksheets("Listes").Sort
        .SetRange Range("e2:e5000")
        .Header = xlGuess
        .MatchCase = False
        .Orientation = xlTopToBottom
        .SortMethod = xlPinYin
        .Apply
    End With
 
'tri de la table des lots
    worksheets("Lots").Select
    Application.Goto Reference:="TableLots"
  ActiveWorkbook.worksheets("Lots").Sort.SortFields.Clear
    ActiveWorkbook.worksheets("Lots").Sort.SortFields.Add Key:=Range("A2:A5000"), _
        SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal
    With ActiveWorkbook.worksheets("Lots").Sort
        .SetRange Range("A2:K5000")
        .Header = xlGuess
        .MatchCase = False
        .Orientation = xlTopToBottom
        .SortMethod = xlPinYin
        .Apply
    End With
    ActiveWorkbook.Save
    Sheets("accueil").Select
 
 
 
End Sub