Düzenle tuşunda mükerrer kayıt sorunu

[Gold_Savt]

Önceden giriş yapılmış bir veriyi 'düzenle' dediğimde problem yaşıyorum.
Çünkü düzenlemeye çalıştığım TC nosu önceden kayıtlı olduğundan mükerrer kayıt hatasıyla işlem gerçekleşmiyor.
Düzenle tuşunda işlenen TC hariç diğer TC'ler için mükerrer kayıt uyarısı vermesi gerekmez mi? Kodu nasıl değiştirmeliyim?


If Yeni_mi = True Then ' Yeni mi kontrolu yap
For i = 8 To Sheets("Data").Range("A65536").End(xlUp).Row
If Sheets("Data").Range("C" & i).Value = TextBox4.Text Then
MsgBox "Düzenlemeye çalıştığınız " & TextBox4 & " TC Numarası, " & TextBox3 & " adına önceden sisteme girilmiştir. Mükerrer kayıt...", vbCritical, "UYARI"
TextBox4.SetFocus
Exit Sub
End If
Next i
Sheets("Data").Cells(r.Row, "B") = UserForm1.TextBox3.Value 'AD SOYAD
Sheets("Data").Cells(r.Row, "C") = UserForm1.TextBox4.Value 'TC
End If

 

[Muzaffer Ali]

Merhaba.
r değişkeninin ne olduğunu nerde set edildiğini yazmamışsınız ama sanırım kodlar şöyle olmalı deneyin.

If Yeni_mi = false Then ' Yeni mi kontrolu yap
Sheets("Data").Cells(r.Row, "B") = UserForm1.TextBox3.Value 'AD SOYAD
Sheets("Data").Cells(r.Row, "C") = UserForm1.TextBox4.Value 'TC
End If

Eğer olmazsa yada farklı bir satırda değişiklik yaparsa "r.row" kısmı yerine değişiklik yaptığınız satır numarasını bulan değişken eklenmeli.

 

[Gold_Savt]

Yine aynı hatayı alıyorum
Set edilme koduyla birlikte Düzeltme Butonuna ait kodlar aşağıdaki gibidir:

Private Sub CommandButton3_Click()  'Üzerine Yaz
Dim r As Variant
UserForm1.ListBox1.RowSource = Empty
ara = txtsırano.Value
Set r = Worksheets("Data").Range("A:A").Find(ara, Lookat:=xlWhole)


If Yeni_mi = True Then ' Yeni mi kontrolu yap
                For i = 8 To Sheets("Data").Range("A65536").End(xlUp).Row
                    If Sheets("Data").Range("C" & i).Value = TextBox4.Text Then
                        MsgBox "Düzenlemeye çalıştığınız " & TextBox4 & " TC Numarası, " & TextBox3 & " adına önceden sisteme girilmiştir. Mükerrer kayıt...", vbCritical, "UYARI"
                        TextBox4.SetFocus
                        Exit Sub
                    End If
                Next i

YesNo = MsgBox("Düzeltme işlemi yapılacak onaylıyor musunuz?", vbYesNo + vbCritical, "Silme Onayı")
Select Case YesNo
Case vbYes

Sheets("Data").Cells(r.Row, "B") = UserForm1.TextBox3.Value 'AD SOYAD
Sheets("Data").Cells(r.Row, "C") = UserForm1.TextBox4.Value 'TC

Case vbNo
MsgBox "Düzenleme işlemini iptal ettiniz.", vbMsgBoxSetForeground
End Select

End If
End Sub

 

[Muzaffer Ali]

Deneyin.

Private Sub CommandButton3_Click()  'Üzerine Yaz
    Dim r As Range
    Dim YesNo As VbMsgBoxResult
   
    UserForm1.ListBox1.RowSource = Empty
    ara = txtsırano.Value
    Set r = Worksheets("Data").Range("A:A").Find(ara, Lookat:=xlWhole)
    If ara Is Nothing Then
        MsgBox "Değiştirmeye çalıştığınız Sıra No: " & txtsırano.Text & " bulunamıyor."
        Exit Sub
    End If

    YesNo = MsgBox("Düzeltme işlemi yapılacak onaylıyor musunuz?", vbYesNo + vbCritical, "Silme Onayı")
    Select Case YesNo
    Case vbYes
        Sheets("Data").Cells(r.Row, "B") = UserForm1.TextBox3.Value 'AD SOYAD
        Sheets("Data").Cells(r.Row, "C") = UserForm1.TextBox4.Value 'TC
    Case vbNo
        MsgBox "Düzenleme işlemini iptal ettiniz.", vbMsgBoxSetForeground
    End Select
End Sub

 

[Gold_Savt]

Değiştirmeye çalıştığınız Sıra no bulunamıyor veriyor sürekli.
Değiştirme işlemini yapmaya geçmiyor malesef hocam.

 

[muratboz06]

dalgalıkur hocam şiir gibi kod yazmışsınız, tebrik ederim.

Gold_Savt
If ara Is Nothing Then
satırını
If r Is Nothing Then olarak değiştirirseniz çalışacaktır.

 

[Gold_Savt]

Düzenleme faal oldu ancak aynı TC noda kayıt imkanını da açtı malesef.

 

[Gold_Savt]

Düzeltme şansımız var mı arkadaşlar?

 

[muratboz06]

Bunu deneyin, dalgalıkur'un koduna ekleme yapılmıştır.

Private Sub CommandButton3_Click()  'Üzerine Yaz
    Dim r As Range
    Dim YesNo As VbMsgBoxResult
 
    Dim tcKontrol As Range
    Set tcKontrol = Worksheets("Data").Range("C:C").Find(UserForm1.TextBox4.Value, Lookat:=xlWhole)
    If tcKontrol Is Nothing Then
   
    UserForm1.ListBox1.RowSource = Empty
    ara = txtsırano.Value
    Set r = Worksheets("Data").Range("A:A").Find(ara, Lookat:=xlWhole)
    If r Is Nothing Then
        MsgBox "Değiştirmeye çalıştığınız Sıra No: " & txtsırano.Text & " bulunamıyor."
        Exit Sub
    End If

    YesNo = MsgBox("Düzeltme işlemi yapılacak onaylıyor musunuz?", vbYesNo + vbCritical, "Silme Onayı")
    Select Case YesNo
    Case vbYes
        Sheets("Data").Cells(r.Row, "B") = UserForm1.TextBox3.Value 'AD SOYAD
        Sheets("Data").Cells(r.Row, "C") = UserForm1.TextBox4.Value 'TC
    Case vbNo
        MsgBox "Düzenleme işlemini iptal ettiniz.", vbMsgBoxSetForeground
    End Select

    Else
    MsgBox UserForm1.TextBox4.Value & " TC numarası " & Sheets("Data").Cells(tcKontrol.Row, "B") & " adına kayıtlıdır."
   
   
    End If
End Sub

 

[Gold_Savt]

Mükerrer kayıtları bu kodlar, net bir şekilde buluyor.
Ancak düzeltme yapacağımız kişinin TC kimlik numarasına dikkat etmemesi gerekiyor ki düzeltme yapabileyim.
Düzenleme yapacağımız kişinin TC numarası hariç diğer kişilerin TC nolarını kontrol etmeli.
Yoksa TC kimlik numarası aynı diye diğer verileri düzeltme imkanı da tanımıyor.
Malesef

 

[muratboz06]

Birde bunu deneyin.

Private Sub CommandButton3_Click()  'Üzerine Yaz
    Dim r As Range
    Dim YesNo As VbMsgBoxResult
    
    Dim tcKontrol As Range
    Set tcKontrol = Worksheets("Data").Range("C:C").Find(UserForm1.TextBox4.Value, Lookat:=xlWhole)
    If tcKontrol Is Nothing Then
  
    UserForm1.ListBox1.RowSource = Empty
    ara = txtsırano.Value
    Set r = Worksheets("Data").Range("A:A").Find(ara, Lookat:=xlWhole)
    If r Is Nothing Then
        MsgBox "Değiştirmeye çalıştığınız Sıra No: " & txtsırano.Text & " bulunamıyor."
        Exit Sub
    End If

    YesNo = MsgBox("Düzeltme işlemi yapılacak onaylıyor musunuz?", vbYesNo + vbCritical, "Silme Onayı")
    Select Case YesNo
    Case vbYes
        Sheets("Data").Cells(r.Row, "B") = UserForm1.TextBox3.Value 'AD SOYAD
        Sheets("Data").Cells(r.Row, "C") = UserForm1.TextBox4.Value 'TC
    Case vbNo
        MsgBox "Düzenleme işlemini iptal ettiniz.", vbMsgBoxSetForeground
    End Select

    Else
    'MsgBox UserForm1.TextBox4.Value & " TC numarası " & Sheets("Data").Cells(tcKontrol.Row, "B") & " adına kayıtlıdır."
    YesNo = MsgBox(UserForm1.TextBox4.Value & " TC numarası " & Sheets("Data").Cells(tcKontrol.Row, "B") & " adına kayıtlıdır." & vbNewLine & "Yine de değişlik yapmaya devam etmek istiyor musunuz?", vbYesNo + vbCritical, "Değişiklik Onay")
   Select Case YesNo
   Case vbYes
        Sheets("Data").Cells(tcKontrol.Row, "B") = UserForm1.TextBox3.Value 'AD SOYAD
        Sheets("Data").Cells(tcKontrol.Row, "C") = UserForm1.TextBox4.Value 'TC
    Case vbNo
        MsgBox "Düzenleme işlemini iptal ettiniz.", vbMsgBoxSetForeground
    End Select
    End If
End Sub

 

[Gold_Savt]

Teşekkür ederim. Sorunsuz çalışıyor.