• DİKKAT

    DOSYA İndirmek/Yüklemek için ÜCRETLİ ALTIN ÜYELİK Gereklidir!
    Altın Üyelik Hakkında Bilgi

userformda mükerrer kayıt

Katılım
3 Mart 2008
Mesajlar
60
Excel Vers. ve Dili
exel 2003
değerli arkadaşlar yapmış olduğum bir user formda mükerrer kayıt girişini engellemek istiyorum yani bir tc numarası ikinci kez girildiğinde bu kayıt falanca sıra numarasında kayıtlı diye bir uyarı verebilirmi acaba yardımlarınızda dolayı şimdiden teşekkür ederim
 
Verebilir de ; bir örnekçalışma ekleseniz de Tc kimlik nereye denk düşüyorsa sizin dosyanıza göre çalışma yapsak , yapboz olmasa ...
 
Sayın simsek3131

Esprili bir çalışma yapılmış.

Dosyayı açtğımızda karşımıza gelen yer herhalde sayfa1, zira dosya uçlarını saklamışsınız. Burada sol üstte yapılan giriş , sağ bölüme değil gizlenen başka bir sayfaya aktarma yapıyor. Ve userform ilk sayfada değil liste sayfasına direk olarak düşürüyor.

Mükerrer kontrolü ve uyarısı istediğiniz; liste sayfası ve buraya kaydı düşüren userform mu?
Bu durumdaön sayfanın bir işlevi var mı ?
 
sayfa 1 de değil liste sayfasında kaydet bütonunda ilk açılış sayfa 1 orada bir işimiz yok bütün işimiz liste sayfasında t.c. kimlik numarası alanı uyarı vermeli
 
Kaydet butonundaki kodlarınızı :

Private Sub CommandButton1_Click()
If TextBox1.Text <> "" Then
Son_Dolu_Satir = Sheets("Data").Range("A65536").End(xlUp).Row
Bos_Satir = Son_Dolu_Satir + 1
Sheets("Data").Range("A" & Bos_Satir).Value = _
Application.WorksheetFunction.Max(Sheets("Data").Range("A:A")) + 1
Sheets("Data").Range("B" & Bos_Satir).Value = TextBox1.Text
Sheets("Data").Range("C" & Bos_Satir).Value = TextBox2.Text
Sheets("Data").Range("D" & Bos_Satir).Value = TextBox3.Text
Sheets("Data").Range("E" & Bos_Satir).Value = TextBox4.Text
Sheets("Data").Range("F" & Bos_Satir).Value = TextBox5.Text
Sheets("Data").Select
Unload UserForm1
Else
MsgBox "İsim Girmeniz Gerekiyor"
End If
If TextBox1.Text <> "" And TextBox2.Text <> "" Then
End If

For d = [d65536].End(3).Row To 1 Step -1
If WorksheetFunction.CountIf(Range("d2:d" & d), Cells(d, "d")) > 1 Then Rows(d).Delete
Next
MsgBox " Çift TC KİMLİK kaydı bulundu ve son girişiniz iptal edildi.", vbCritical, "MÜKERRER"
End Sub

ile değiştirip dener misiniz ? Uyarı vererek kaydettiğiniz satırı iptal edecek. Ekte üstadların bir araya toparladığı mükerrer kayıt örnekleri var, ilginizi çekebilir.
 

Ekli dosyalar

Son düzenleme:
sayın cems
emeğinize teşekkür ederim saolun yanlız her girişte kayıt olsun olmasın
Çift TC KİMLİK kaydı bulundu ve son girişiniz iptal edildi. uyarısı çıkıyor neden acaba
 
sayın cems
emeğinize teşekkür ederim saolun yanlız her girişte kayıt olsun olmasın
Çift TC KİMLİK kaydı bulundu ve son girişiniz iptal edildi. uyarısı çıkıyor neden acaba

Kodları şu şekilde düzeltip dener misiniz ?

Private Sub CommandButton1_Click()
Sheets("Data").Select
If TextBox1.Text = "" Or TextBox2.Text = "" Then
MsgBox "İsim Girmeniz Gerekiyor"
Exit Sub
End If

Son_Dolu_Satir = Sheets("Data").Range("b65536").End(xlUp).Row
Bos_Satir = Son_Dolu_Satir + 1
Sheets("Data").Range("A" & Bos_Satir).Value = _
Application.WorksheetFunction.Max(Sheets("Data").R ange("A:A")) + 1
Sheets("Data").Range("B" & Bos_Satir).Value = TextBox1.Text
Sheets("Data").Range("C" & Bos_Satir).Value = TextBox2.Text
Sheets("Data").Range("D" & Bos_Satir).Value = TextBox3.Text
Sheets("Data").Range("E" & Bos_Satir).Value = TextBox4.Text
Sheets("Data").Range("F" & Bos_Satir).Value = TextBox5.Text

MsgBox " Kayıt tamamlandı", vbCritical

Unload UserForm1
For d = [d65536].End(3).Row To 1 Step -1
If WorksheetFunction.CountIf(Range("d2:d" & d), Cells(d, "d")) = 1 Then
Exit Sub
End If

If WorksheetFunction.CountIf(Range("d2:d" & d), Cells(d, "d")) > 1 Then Rows(d).Delete
MsgBox " Çift TC KİMLİK kaydı bulundu ve son girişiniz iptal edildi.", vbCritical, "MÜKERRER"
Next
thisworkbook.save
End Sub

çift kaydı hemen silmiyor, görmenizi bekliyor ve uyarıya ok dediğinizde siliyor.
 
Kolay gelsin
 
Geri
Üst