Mükerrer Kayıt Engellemek

[polis-53]

merhaba arkadaşlar ekteki kodda A Sutünuna bakarak mükerrer kayıt nasıl engellerim.
Private Sub CommandButton1_Click()
Dim Satır As Long, Say As Byte
If TextBox1.Text = Empty Then
MsgBox "KURUM NO GİRMEDEN KAYIT YAPAMAZSINIZ", vbExclamation, "": Exit Sub
End If


Worksheets("Sayfa1").Select
Satır = Range("A65536").End(3).Row + 1
Cells(Satır, "A") = TextBox1.Text
Cells(Satır, "B") = TextBox2.Text
Cells(Satır, "C") = TextBox3.Text
Cells(Satır, "D") = TextBox4.Text
Cells(Satır, "E") = TextBox5.Text
Cells(Satır, "F") = TextBox6.Text
Cells(Satır, "G") = TextBox7.Text
Cells(Satır, "H") = TextBox8.Text
Cells(Satır, "I") = TextBox9.Text
Cells(Satır, "J") = TextBox10.Text
Cells(Satır, "K") = TextBox11.Text
Cells(Satır, "L") = TextBox12.Text
Cells(Satır, "M") = TextBox13.Text
Cells(Satır, "N") = TextBox14.Text
Cells(Satır, "O") = TextBox15.Text
Cells(Satır, "P") = TextBox16.Text
Cells(Satır, "Q") = TextBox17.Text

Cells.EntireColumn.AutoFit
MsgBox "SEÇİLEN KAYIT YAPILMIŞTIR.", vbExclamation, ""
End Sub

 

[DoğanD]

Ben genelde Eğersay kullanıyorum fakat eminin daha doğru bir yolu vardır

Kodu test edemedim, ufak düzeltmeler gerekebilir.

...
End If

If worksheetfunction.Countif(sayfa1.range("A:A"),Textbox1.text)>0 then
msgbox Textbox1.text & " Değeri için zaten kayıt var!", vbcritical, "Mükrerrer Kayıt"
Exit sub
end if


Worksheets("Sayfa1").Select
Satır = Range("A65536").End(3).Row + 1
Cells(Satır, "A") = TextBox1.Text
...

 

[cems]

Private Sub CommandButton1_Click()
    Dim Satır As Long
    Dim KurumNo As String
    
    ' Kurum No'nun girilip girilmediğini kontrol et
    If TextBox1.Text = Empty Then
        MsgBox "KURUM NO GİRMEDEN KAYIT YAPAMAZSINIZ", vbExclamation, "": Exit Sub
    End If
    
    ' Kurum No'yu al
    KurumNo = TextBox1.Text
    
    ' A sütununda veri ara
    If WorksheetFunction.CountIf(Worksheets("Sayfa1").Columns("A"), KurumNo) > 0 Then
        MsgBox "Bu KURUM NO zaten kayıtlı!", vbExclamation, "Mükerrer Kayıt": Exit Sub
    End If
    
    ' Yeni kaydı eklemek için işlemler
    Satır = Worksheets("Sayfa1").Cells(Rows.Count, 1).End(xlUp).Row + 1
    With Worksheets("Sayfa1")
        .Cells(Satır, "A").Value = TextBox1.Text
        .Cells(Satır, "B").Value = TextBox2.Text
        .Cells(Satır, "C").Value = TextBox3.Text
        .Cells(Satır, "D").Value = TextBox4.Text
        .Cells(Satır, "E").Value = TextBox5.Text
        .Cells(Satır, "F").Value = TextBox6.Text
        .Cells(Satır, "G").Value = TextBox7.Text
        .Cells(Satır, "H").Value = TextBox8.Text
        .Cells(Satır, "I").Value = TextBox9.Text
        .Cells(Satır, "J").Value = TextBox10.Text
        .Cells(Satır, "K").Value = TextBox11.Text
        .Cells(Satır, "L").Value = TextBox12.Text
        .Cells(Satır, "M").Value = TextBox13.Text
        .Cells(Satır, "N").Value = TextBox14.Text
        .Cells(Satır, "O").Value = TextBox15.Text
        .Cells(Satır, "P").Value = TextBox16.Text
        .Cells(Satır, "Q").Value = TextBox17.Text
        .Cells.EntireColumn.AutoFit
    End With
    
    MsgBox "SEÇİLEN KAYIT YAPILMIŞTIR.", vbExclamation, ""
End Sub

Bu kod , kullanıcının girdiği "KURUM NO" değerini "A" sütununda arar ve eğer bu değer zaten mevcutsa kullanıcıya bir uyarı mesajı gösterir ve işlemi durdurur. Eğer bu değer mevcut değilse, yeni kaydı eklemeye devam eder.

 

[polis-53]

ÇOK TEŞEKKÜR EDERİM

 

[cems]

kolay gelsin