Soru Userform Üzerinden Kaydetmek

Katılım
7 Şubat 2021
Mesajlar
455
Excel Vers. ve Dili
2010, Türkiye
Ekli dosyada Userform1 üzerinden Dava No,Adı-soyadı,Baba adı ve mahkeme bilgilerini girip kaydet butonuna bastığımda veriler kayıtlar sayfasına kayıt yapılıyor. Makroyu kendi dosya uyarladım .Fakat bir yerde yanlışlık var bir türlü bulamadım. Userform1 de Textbox1 e kayıtlar sayfasında var olan aynı takip numarası var ise "Önceden kayıt yapılmış Güncellensin mi? diye uyarı vermesi gerekirken ,vermeyerek aynı kayıttan tekrar yeni bir kayıt yapıyor. Oysa olmayan bir dava numarası girdiğim zaman "Yeni bir kayıt yapmak istiyor musunuz? evet/hayır seçeneği gelmesi gerekiyordu. İlgili makroyu bu şekilde revize eder misiniz ?
https://dosyam.org/1PtH/DAVA.xlsb

Kod:
Private Sub CommandButton1_Click()
On Error Resume Next
       Set kyt = Sheets("KAYITLAR")
    
    no = TextBox1.Value
    
If no = Empty Then MsgBox "DAKA TAKİP NO BOŞ OLMAZ!", vbCritical, "D İ K K A T": Exit Sub
    ss1 = kyt.Cells(Rows.Count, 3).End(xlUp).Row
    dur = 1
  
    dur = Empty
    ss = kyt.Cells(Rows.Count, 2).End(xlUp).Row
    kyt.Range("B" & ss + 1 & ":X" & ss1 + 1).ClearContents
    say = WorksheetFunction.Match(no, kyt.Columns(2), 0)
If say <> Empty Then
    cvp = MsgBox("Önceden kayıt yapılmış Güncellensin mi? ", vbQuestion + vbYesNo + vbDefaultButton2, "D İ K K A T")
    If cvp = vbNo Then Exit Sub
End If
If say = Empty Then
    cvp2 = MsgBox("Yeni bir kayıt yapmak istiyor musunuz?", vbQuestion + vbYesNo + vbDefaultButton2, "D İ K K A T")
    If cvp2 = vbNo Then Exit Sub Else: say = ss + 1
End If
    dur = 1
    kyt.Cells(say, 1) = say - 3
    kyt.Cells(say, 2) = TextBox1.Value
    kyt.Cells(say, 3) = TextBox2.Value
    kyt.Cells(say, 4) = TextBox3.Value
    kyt.Cells(say, 5) = TextBox4.Value
    
     dur = Empty
    ss = kyt.Cells(Rows.Count, 2).End(xlUp).Row
    If ss = 2 Then ss = 3

  If say = ss1 + 1 Then '<==  ss + 1 yerine ss1 + 1 yazıldı
      MsgBox "Yeni kayıt başarı ile yapıldı", vbInformation, "T E B R İ K L E R"

Else
    MsgBox "Kayıt başarı ile güncellendi", vbInformation, "T E B R İ K L E R"

End If
  

End Sub
https://dosyam.org/1PtG/DAVA.xlsb
 

Muzaffer Ali

Destek Ekibi
Destek Ekibi
Katılım
5 Haziran 2006
Mesajlar
6,167
Excel Vers. ve Dili
2019 Türkçe
Merhaba.
Aşağıdaki kodu deneyin.


Kod:
Private Sub CommandButton1_Click()
    Dim Bak As Range
    Dim Msj As String
    Dim syfKyt As Worksheet
    Dim Say As Long
    Dim No As String
    Set syfKyt = Worksheets("KAYITLAR")
    No = TextBox1.Value
    If No = Empty Then MsgBox "DAKA TAKİP NO BOŞ OLMAZ!", vbCritical, "D İ K K A T":    Exit Sub
    Say = syfKyt.Cells(Rows.Count, 2).End(xlUp).Row
    syfKyt.Range("B" & Say + 1 & ":X" & Say + 1).ClearContents
    Set Bak = syfKyt.Range("B:B").Find(what:=No, lookat:=xlWhole)
    If Not Bak Is Nothing Then
        If MsgBox("Önceden kayıt yapılmış Güncellensin mi? ", vbQuestion + vbYesNo + vbDefaultButton2, "D İ K K A T") = vbNo Then Exit Sub
        Msj = TextBox1.Value & " Nolu Dava Kaydı Güncellendi."
        Say = Bak.Row - 1
    Else
        If MsgBox("Yeni bir kayıt yapmak istiyor musunuz?", vbQuestion + vbYesNo + vbDefaultButton2, "D İ K K A T") = vbNo Then Exit Sub
        Msj = "Yeni kayıt başarı ile yapıldı."
    End If
    syfKyt.Cells(Say + 1, 1) = Say - 2
    syfKyt.Cells(Say + 1, 2) = TextBox1.Value
    syfKyt.Cells(Say + 1, 3) = TextBox2.Value
    syfKyt.Cells(Say + 1, 4) = TextBox3.Value
    syfKyt.Cells(Say + 1, 5) = TextBox4.Value
    MsgBox Msj, vbInformation, "T E B R İ K L E R"
End Sub
 
Son düzenleme:
Katılım
7 Şubat 2021
Mesajlar
455
Excel Vers. ve Dili
2010, Türkiye
Hocam teşekkür ederim. Yeni Kayıt yapıldığında "Yeni Kayıt Yapıldı" ;Kayıt güncellemesi yapıldığında ise "....... Nolu Dava Kaydı Güncellendi "uyarısı verilebilir mi?.
 

Muzaffer Ali

Destek Ekibi
Destek Ekibi
Katılım
5 Haziran 2006
Mesajlar
6,167
Excel Vers. ve Dili
2019 Türkçe
Yukardaki kodu yeniden düzenledim.
 
Katılım
7 Şubat 2021
Mesajlar
455
Excel Vers. ve Dili
2010, Türkiye
Muzaffer bey desteğiniz için çok teşekkür ederim
 
Üst