Bonjour,
Bonjour,
très 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 repéré
mais ,ou cela se gate, c'est après la validation de la msgbox, la copie de tous les champs se fait sans la valeur du code qui est efface.
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 :)
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
Configuration: Windows Vista
Firefox 2.0.0.14