Tek buton ile hem kaydet hem de güncelle

sirkülasyon

Altın Üye
Katılım
10 Temmuz 2012
Mesajlar
2,492
Excel Vers. ve Dili
2021 LTSC TR
Altın Üyelik Bitiş Tarihi
18-06-2026
Kod:
Özel Abone Kaydet_Click()
    'mesaj kutusu devreye giriyor.
    If MsgBox("Bu kayıt kayıt dosyası kaydedilecek mi?", vbYesNo) = vbNo Sonra Çıkış Sub
   
    As Çalışma Sayfasını Dim, Tamsayı Olarak Say, ara As String, bul As Range, x As Integer
    Set a = Worksheets("Kayıt")
   
    Say = Application.WorksheetFunction.CountIfs(a.Range("B:B")), TextBox17, _
      a.Range("P:P"), IIf(TextBox18 = "", "*", TextBox18), _
      a.Range("G:G"), IIf(TextBox5 = "", "*", TextBox5), _
      a.Range("H:H"), IIf(TextBox6 = "", "*", TextBox6))
   
    > 0 ise O zaman
    If MsgBox("Bu kayıt daha önce yapılmış!" & vbLf & "Yine de işlemeye devam etmek istiyor musunuz?", vbCritical + vbYesNo + vbDefaultButton2) = vbNo Then
        MsgBox "Kayıt işlemi iptal edilmiştir.", vbInformation
        Alttan Çık
    Eğer Sonlandır
    Eğer Sonlandır
            Say = WorksheetFunction.CountA(a.Range("A2:A65536")) + 1
   
    a.Hücreler(Say + 1, 1).Değer = Say
    a.Cells(Say + 1, 2).Value = TextBox17.Value
    a.Cells(Say + 1, 3).Value = TextBox1.Value
    a.Cells(Say + 1, 4).Value = TextBox2.Value
    a.Cells(Say + 1, 5).Value = TextBox16.Value
    a.Cells(Say + 1, 6).Value = TextBox4.Value
    a.Cells(Say + 1, 7).Value = TextBox5.Value
    a.Cells(Say + 1, 8).Value = TextBox6.Value
    a.Cells(Say + 1, 9).Value = TextBox7.Value
    a.Cells(Say + 1, 10).Value = TextBox8.Value
    a.Cells(Say + 1, 11).Value = TextBox9.Value
    a.Cells(Say + 1, 12).Value = TextBox10.Value
    a.Cells(Say + 1, 13).Value = TextBox11.Value
    a.Cells(Say + 1, 14).Value = TextBox12.Value
    a.Cells(Say + 1, 15).Value = TextBox13.Value
    a.Cells(Say + 1, 16).Value = TextBox18.Value
    ActiveWorkbook.Save
    MsgBox "Bu kayıt kayıt listesi kaydedildi", vbCritical, "UYARI"
    Hata Durumunda Devam Ettirin Sonraki
Kod:
 If MsgBox("Bu kayıt daha önce yapılmış!" & vbLf & "Yine de işlemeye devam etmek istiyor musunuz?", vbCritical + vbYesNo + vbDefaultButton2) = vbNo Then
Evet ise TextBox2.Value değeri sayfasında E sütununda arayacak içeriğin C:AJ aralığındaki ki listeleri yeniden temizlenecek kayıt yapacak. Ve Kayıt sınrı 65 satırla sınırlanacak.
Rica etsem bana yardımcı olabilir misiniz?
 
Son düzenleme:

sirkülasyon

Altın Üye
Katılım
10 Temmuz 2012
Mesajlar
2,492
Excel Vers. ve Dili
2021 LTSC TR
Altın Üyelik Bitiş Tarihi
18-06-2026
Kod:
Dim a As Worksheet
Set a = ThisWorkbook.Sheets("Bordro")
Dim aranan As String
aranan = Me.Txtkimlilkno.Value
Dim bulunanHücre As Range
Set bulunanHücre = a.Columns("E").Find(aranan, LookIn:=xlValues, lookat:=xlWhole)

If Not bulunanHücre Is Nothing Then
    Dim hücre As Range
    For Each hücre In a.Range("G" & bulunanHücre.Row & ":AI" & bulunanHücre.Row)
        hücre.ClearContents
    Next hücre
    BtnKaydet.Caption = "Güncelle"
    a.Cells(bulunanHücre.Row, "C").Value = Label55.Caption
    a.Cells(bulunanHücre.Row, "D").Value = TxtAdıSoyadı.Value
    a.Cells(bulunanHücre.Row, "E").Value = Txtkimlilkno.Value

Else
    Dim satırsayısı As Integer
    satırsayısı = WorksheetFunction.CountA(a.Range("B8:B65536")) + 1
    a.Cells(satırsayısı + 7, "B").Value = satırsayısı
    a.Cells(satırsayısı + 7, "C").Value = Label55.Caption
    a.Cells(satırsayısı + 7, "D").Value = TxtAdıSoyadı.Value
    a.Cells(satırsayısı + 7, "E").Value = Txtkimlilkno.Value
Böyle bir düzenleme ile sorunu hemen hemen çözdüm gibi ama bu sefer de satırsayısı B sütununa sıra numarası vermiyor.
 
Üst