Doublons

[Provence Vintage]

Comment puis-je trouver une parade!

Un Usf m'enregistre via macro données dans feuille.
1ère colonne de ma feuille "Nom"
Le hic: si on a deux fois le même Nom, et oui, ça arrive, comment forcer pour une saisie du genre, "existe déjà" ou "mettre un autre Nom" ou d'office "Nom"2
Avec le code d'origine qui enregistre dans ma feuille:

Private Sub CommandButton1_Click()
Application.ScreenUpdating = False


Sheets("Base de Données acheteurs").Activate
Dim NomDeFeuilEnCours$, lidep1 As Long, cellule As Range
NomDeFeuilEnCours = "Base de Données acheteurs"
Dim Ctrl As Control
Dim Valeur As String
Dim Vr As Byte, Fx As Byte
Dim Coul&
CoulRouge = 3: CoulNoir = 1
PalRouge& = &HC0&: PalNoir& = &H80000008




For Each Ctrl In Me.Controls
If TypeOf Ctrl Is MSForms.CheckBox Then
If Ctrl.Value = True Then
Valeur = Valeur & Ctrl.Name & " = True " & Chr(10)
Vr = Vr + 1
Else
Valeur = Valeur & Ctrl.Name & " =False " & Chr(10)
Fx = Fx + 1
If CréerFicheAcquéreur.TextBox9.Value = "" Then
MsgBox " Le Nom de l'acquéreur est obligatoire . "
Exit Sub
End If
End If
End If
Next


li = Range("A6000").End(xlUp).Row
li = li + IIf(li < 4, 2, 1) ' à cause des lignes fusionnées !
Cells(li, 1) = TextBox9.Value
Cells(li, 2) = TextBox10.Value
Cells(li, 2) = TextBox10.Value
Cells(li, 3) = TextBox5.Value
Cells(li, 4) = TextBox24.Value
Cells(li, 5) = TextBox25.Value
Cells(li, 6) = TextBox22.Value
Cells(li, 7) = IIf(OptionButton15, "Tous secteurs", "")
Cells(li, 16) = IIf(CheckBox1, "MDV", "") & IIf(CheckBox2, "Appart", "") & IIf(CheckBox3, "Villa", "") & IIf(CheckBox4, "Mas", "") & IIf(CheckBox5, "Terrain", "")
Cells(li, 17) = TextBox2.Value
Cells(li, 18) = IIf(CheckBox11, "Oui", "")
Cells(li, 19) = TextBox3.Value
Cells(li, 20) = TextBox4.Value
Cells(li, 21) = IIf(OptionButton1, "Oui", "")
Cells(li, 22) = IIf(OptionButton2, "Oui", "")
Cells(li, 23) = TextBox7.Value
Cells(li, 24) = TextBox8.Value
Cells(li, 25) = IIf(CheckBox6, "Oui", "")
Cells(li, 26) = IIf(CheckBox7, "Oui", "")
Cells(li, 27) = IIf(CheckBox8, "Oui", "")
Cells(li, 28) = IIf(CheckBox9, "Oui", "")
Cells(li, 29) = IIf(OptionButton11, "Cuisine US", "")
Cells(li, 29) = IIf(OptionButton10, "Cuisine séparée", "")
Cells(li, 30) = IIf(CheckBox10, "Oui", "")
Cells(li, 31) = TextBox20.Value
Cells(li, 32) = TextBox21.Value
Cells(li, 33) = IIf(CheckBox12, "Oui", "")
Cells(li, 34) = IIf(CheckBox13, "Oui", "")
Cells(li, 35) = TextBox23.Value
Cells(li, 36) = IIf(CheckBox14, "Oui", "")
Cells(li, 37) = TextBox19.Value
If ComboBox1.ForeColor = PalNoir& Then c = CoulNoir Else c = CoulRouge
Cells(li, 8).Value = ComboBox1.Value
Cells(li, 8).Font.ColorIndex = c
If ComboBox2.ForeColor = PalNoir& Then c = CoulNoir Else c = CoulRouge
Cells(li, 9).Value = ComboBox2.Value
Cells(li, 9).Font.ColorIndex = c
If ComboBox3.ForeColor = PalNoir& Then c = CoulNoir Else c = CoulRouge
Cells(li, 10).Value = ComboBox3.Value
Cells(li, 10).Font.ColorIndex = c
If ComboBox4.ForeColor = PalNoir& Then c = CoulNoir Else c = CoulRouge
Cells(li, 11).Value = ComboBox4.Value
Cells(li, 11).Font.ColorIndex = c
If ComboBox5.ForeColor = PalNoir& Then c = CoulNoir Else c = CoulRouge
Cells(li, 12).Value = ComboBox5.Value
Cells(li, 12).Font.ColorIndex = c
If ComboBox6.ForeColor = PalNoir& Then c = CoulNoir Else c = CoulRouge
Cells(li, 13).Value = ComboBox6.Value
Cells(li, 13).Font.ColorIndex = c
If ComboBox7.ForeColor = PalNoir& Then c = CoulNoir Else c = CoulRouge
Cells(li, 14).Value = ComboBox7.Value
Cells(li, 14).Font.ColorIndex = c
If ComboBox8.ForeColor = PalNoir& Then c = CoulNoir Else c = CoulRouge
Cells(li, 15).Value = ComboBox8.Value
Cells(li, 15).Font.ColorIndex = c

Call trierzonedetriacheteurs
Call calculnombrefichesacheteurs
Unload Me


Application.ScreenUpdating = True
SaisirPije.Hide
Accueil.Show
CréerFicheAcquéreur.Hide
Accueil.Show
End Sub


La plus importante étant: Cells(li, 1) = TextBox9.Value
puisque c celle qui me check le nom ds ma base de données.....

Faut'il passer par (exemple):

Etre averti lors de la saisie des doublons dans la plage A1:A5000

Procédure à placer au niveau de la feuille en utilisant l'evenement "Change"

Private Sub Worksheet_Change(byVal Target As Excel.Range)

If Target.Column = 1 Then

If Application.worksheetFunction.countIf(Range("A1:A5 000"), Target.Value) > 1 Then msgBox "ce nom existe déja"

End If

End Sub

 

[Bebere]

Re : Doublons

bonjour le fil
pinot vintage essaye ce code

Private Sub Nom_afterupdate()
Dim cellule As Range, PremièreAdresse As String,Compte as byte
compte=0
Sheets("bdd acheteur").Activate
With Worksheets("bdd acheteur").Range("B2:B" & Range("B65536").End(xlUp).Row)
Set cellule = .Find(Nom.Text)
If Not cellule Is Nothing Then
PremièreAdresse = cellule.Address
Do
If Cells(cellule.Row, 2).Value = Nom.Text Then
compte=compte+1
end if
Set cellule = .FindNext(cellule)
Loop While Not cellule Is Nothing And cellule.Address <> PremièreAdresse
End If
End With

if compte>0 then
msgbox "doublon"
nom.value=""
nom.setfocus
end if

RechetCréaAcquéreur.Label45.Caption = "Ligne N°" & cellule.Row

End Sub
à bientôt

 

[Provence Vintage]

Re : Doublons

Bebere, Le Fil,

il bloque au même endroit:
RechetCréaAcquéreur.Label45.Caption = "Ligne N°" & cellule.Row

quand tu test avec un nom qui n'est pas dans la bdd ??????

Je fais des test aussi sur une autre méthode:

en partant du principe que je fais mes enregistrement avec la clef primaire suivante:
Nom & " " & Prenom & " " & Right(TelMobile, 6)
(enregistrée dans ma colonne A, pour justement permettre la saisie d'homonymes, mais sans doublons,)

Une fois Nom Saisi, Prenom saisi et TelPortable saisi, j'essaye de mettre à la sortie de la TextBox "TelPortable" Un check de ma bdd prenant en compte les valeurs saisie et allant chercher la clef dans la colonne A
Mais comment faire avec:Nom & " " & Prenom & " " & Right(TelMobile, 6)

Je ne sais le faire qu'avec Une TextBox!

Merci

 

[JNP]

Re : Doublons

Re ,
Tu n'as pas bien suivi mon code fourni sur l'autre fil. Il localisait et le produit, et le code produit, ce qui adapté à ton cas pouvait être nom et prénom, à la sortie du combobox prénom... Sur la base de nom en A, prénom en B et téléphone en C

Dim Cellule As Range, PremièreAdresse As String, MyString As String
With Worksheets("[B][COLOR=red]LISTE[/COLOR][/B]").Range("[COLOR=red][B]A1:A[/B][/COLOR]" & Range("B65536").End(xlUp).Row)
[COLOR=seagreen]' modifier bien sûr le nom de la feuille et la rangée où sont les prénoms[/COLOR]
    Set Cellule = .Find([COLOR=red][B]TextBox1[/B][/COLOR].Text)
   [COLOR=seagreen]' mettre le textbox où il y a le nom[/COLOR]
    If Not Cellule Is Nothing Then
        PremièreAdresse = Cellule.Address
        Do
            If Cellule.Offset(0, [COLOR=red][B]1[/B][/COLOR]).Value = [COLOR=red][B]TextBox2[/B][/COLOR].Text Then
           [COLOR=seagreen]' offset 1 si la rangée prénom est à côté du nom, textbox2 textbox prénom[/COLOR]
                MyString = MyString & vbCrLf & Cellule & " " & Cellule.Offset(0, [COLOR=red][B]1[/B][/COLOR]) _
                    & " " & Cellule.Offset(0, [COLOR=red][B]2[/B][/COLOR])
                    [COLOR=seagreen]' j'ajoute dans ma string retour chariot, nom, prénom et téléphone[/COLOR]
            Set Cellule = .FindNext(Cellule)
        Loop While Not Cellule Is Nothing And Cellule.Address <> PremièreAdresse
    End If
    If MyString = "" Then Exit Sub
End With
MsgBox "Il existe déjà" & MyString

A +

 

[Provence Vintage]

Re : Doublons

JNP, Le Fil

J'ai testé, mais il me met "Do sans boucle"....

D'autre part, après réflexion:
Partons du principe que tu as un seul USF, avec lequel, tu saisi un nom,
qui te permet si n'existe pas et en effet sans doublons, d'enregistrer des éléments dans une base de données;
l'USF te permet aussi de consulter, de modifier...
Imaginons que l'objectif est la recherche, facile avec le nom, par contre, tu n'as pas forcément le tel en mémoire,.....
Bouh, c compliqué....

Si quelqu'un à une idée!?

a+ de te et de vous lire
Merci encore

 

[JNP]

Re : Doublons

Re ,

If Cellule.Offset(0, 1).Value = TextBox2.Text Then
' offset 1 si la rangée prénom est à côté du nom, textbox2 textbox prénom
MyString = MyString & vbCrLf & Cellule & " " & Cellule.Offset(0, 1) _
     & " " & Cellule.Offset(0, 2)
' j'ajoute dans ma string retour chariot, nom, prénom et téléphone
[COLOR=red][B]End If[/B][/COLOR]
Set Cellule = .FindNext(Cellule)

Effectivement, il manquait un End If.
Maintenant, c'est toujours le même problème. Il y a la recherche de doublons possible (mon code ci-dessus), et la recherche de l'existant. La recherche de doublons t'indiques les existants avec le nom, le prénom, et le tél. Pas de problème pour la recherche, il te suffit de stocker les résultats dans un tableau.
Bonne soirée

 

[Provence Vintage]

Re : Doublons

Re,

#Private Sub TelMobile_Exit(ByVal Cancel As MSForms.ReturnBoolean)
Dim Cellule As Range, PremièreAdresse As String, MyString As String
With Worksheets("bdd acheteur").Range("A1:A" & Range("B65536").End(xlUp).Row)
' modifier bien sûr le nom de la feuille et la rangée où sont les prénoms
Set Cellule = .Find(Nom.Text)
' mettre le textbox où il y a le nom
If Not Cellule Is Nothing Then
PremièreAdresse = Cellule.Address
Do
If Cellule.Offset(0, 1).Value = Prenom.Text Then
' offset 1 si la rangée prénom est à côté du nom, textbox2 textbox prénom
MyString = MyString & vbCrLf & Cellule & " " & Cellule.Offset(0, 1) _
& " " & Cellule.Offset(0, 2)
' j'ajoute dans ma string retour chariot, nom, prénom et téléphone
End If
Set Cellule = .FindNext(Cellule)
Loop While Not Cellule Is Nothing And Cellule.Address <> PremièreAdresse
End If
If MyString = "" Then Exit Sub
End With
MsgBox "Il existe déjà" & MyString

End Sub


Rien ne se passe?!?
Doit être fatigué, ou pas compris...

 

[JNP]

Re : Doublons

Re ,
Ne le prends pas mal, mais j'ai l'impression que tu n'analyses pas vraiment les codes fournis...
Un petit exemple en pièce jointe, appuie sur CommandButton1, puis rentre Toto et valide, puis, en te remettant dans le premier textbox Tata, puis valide, enfin, Titi...
Tu commenceras peut-être à suivre ma pensée .
Bonne soirée