Tüm koşullara uyan mükerrer kayıt silme

[fatihbozkurt58]

Birden fazla sütuna bakarak mükerrer kayıt silme

Aşağıda verdiğim kod ile sayfaya veri kayıtı yapıyorum. Kayıt işlemi biraz karışık çünkü kopyalama işlemleri yapıyor. Herhangi bir kayıt yaptığımda kayıt işlemi tamamlandığında satırdaki verilerin tümü olarak aynısından başka kayıt varsa uyarı mesajı vererek kayıtın iptal edilmesini istiyorum.Mükerrer kayıt kontrollerini sadece b sütununa göre yapmasını istemiyorum çünkü b sütununda aynı isimde kayıtlar bulunuyor. Eğer "b,c,d" sütunlarının 3 üne birden bakarak aynı kayıt bulunuyorsa mükerrer kayıt hatası vermesi için ne yapmalıyız?

Private Sub CommandButton3_Click()
If ComboBox1.Value = "" Then
    MsgBox "Lütfen listeden öğrenci seçiniz!"
    ComboBox1.SetFocus
Exit Sub
End If
If ComboBox2.Value = "" Then
    MsgBox "Lütfen listeden telafi saatini seçiniz!"
    ComboBox2.SetFocus
Exit Sub
End If
If TextBox1.Value = "" Then
    MsgBox "Lütfen telafi tarihini seçiniz!"
    TextBox1.SetFocus
Exit Sub
End If

With Worksheets("Veri")
    sonsatir = .Range("a65536").End(3)(2, 1).Row
If .Range("a2").Value = "" Then
    sonsatir = 2
End If
Set bak = .Range("b:b").Find(ComboBox1.Text, , , 1)
If Not bak Is Nothing Then
    If bak.Offset(0, 1).Value = CLng(CDate(TextBox1.Text)) _
    And bak.Offset(0, 2).Value = ComboBox2.Text Then
       MsgBox "Seçmiş olduğunuz öğrenci,tarih ve saate ait kayıt bulunmaktadır.. Lütfen kontrol ediniz. "
       Unload Me
      
    Exit Sub
    End If
End If
Set bak = Nothing
    .Range("a" & sonsatir).Value = sonsatir - 1
With .Range("a" & sonsatir)
    .Offset(0, 1).Value = ComboBox1.Text
    .Offset(0, 2).Value = CLng(CDate(TextBox1))
    .Offset(0, 3).Value = ComboBox2.Text
    .Offset(0 - 1, 11).Copy Destination:=.Offset(0, 11)
    .Offset(0 - 1, 12).Copy Destination:=.Offset(0, 12)
    .Offset(0 - 1, 13).Copy Destination:=.Offset(0, 13)
    .Offset(0 - 1, 14).Copy Destination:=.Offset(0, 14)
    .Offset(0 - 1, 15).Copy Destination:=.Offset(0, 15)
    .Offset(0 - 1, 16).Copy Destination:=.Offset(0, 16)
    .Offset(0, 14).Copy Destination:=.Offset(0, 4)
    .Offset(0, 15).Copy Destination:=.Offset(0, 5)
End With
End With
aciklama = "Kayıt İşlemi Başarıyla Tamamlandı"
dugme = vbOKOnly + vbInformation + vbDefaultButton1
baslik = "KAYIT"
MsgBox aciklama, dugme, baslik
Unload Me
End Sub

 

[fatihbozkurt58]

Arkadaşlar konuyla ilgili yardımlarınızı bekliyorum.

 

[fatihbozkurt58]

Sütunların üçü birden aynı ise mükerrer kayıt hatası vermesini istiyorum. kodu nasıl düzenlemeliyim?

 

[Korhan Ayhan]

Merhaba,

Konuyla ilgili küçük bir örnek dosya eklermisiniz.

 

[fatihbozkurt58]

örnek dosyayı ekledim aynı isimden birden çok olunca sadece ilkine bakıyor mükerrer kayıt kontrolünde bu sebeple 3 sütuna birden bakarak kontrol etmesini istiyorum.

 

[Korhan Ayhan]

Merhaba,

Aşağıdaki kodu denermisiniz.

Private Sub CommandButton3_Click()
    Dim Satir As Long, Bul As Range, Adres As String
        
    If TextBox1 = "" Then
        MsgBox "Lütfen ADI-SOYADI bilgisini giriniz !", vbExclamation
        TextBox1.SetFocus
        Exit Sub
    End If
 
    If TextBox2 = "" Then
        MsgBox "Lütfen TELAFİ TARİHİ bilgisini giriniz !", vbExclamation
        TextBox2.SetFocus
        Exit Sub
    End If
 
    If TextBox3 = "" Then
        MsgBox "Lütfen TELAFİ SAATİ bilgisini giriniz !", vbExclamation
        TextBox3.SetFocus
        Exit Sub
    End If
 
    Satir = Cells(Rows.Count, 1).End(3).Row + 1
    
    Set Bul = Range("B:B").Find(TextBox1, , , xlWhole)
    If Not Bul Is Nothing Then
        Adres = Bul.Address
        Do
            If Bul.Offset(0, 1) = CDate(TextBox2) And Bul.Offset(0, 2) = TextBox3 Then
                MsgBox "Girdiğiniz bilgiler daha önce kayıt edilmiştir !" & Chr(10) & _
                       "Lütfen kontrol ediniz !", vbCritical, "Mükerrer Kayıt"
                TextBox1 = ""
                TextBox2 = ""
                TextBox3 = ""
                TextBox1.SetFocus
                Exit Sub
            End If
                
            Set Bul = Range("B:B").FindNext(Bul)
        Loop While Not Bul Is Nothing And Adres <> Bul.Address
    End If
 
    Cells(Satir, 1) = Satir - 1
    Cells(Satir, 2) = TextBox1
    Cells(Satir, 3) = CDate(TextBox2)
    Cells(Satir, 4) = TextBox3
    TextBox1 = ""
    TextBox2 = ""
    TextBox3 = ""
    TextBox1.SetFocus
 
    MsgBox "Kayıt işlemi tamamlanmıştır.", vbInformation
End Sub

 

[fatihbozkurt58]

Korhan Bey yardımlarınız için teşekkür ediyorum sorun çözülmüştür.