• DİKKAT

    DOSYA İndirmek/Yüklemek için ÜCRETLİ ALTIN ÜYELİK Gereklidir!
    Altın Üyelik Hakkında Bilgi

Tek buton ile hem kaydet hem de güncelle

sirkülasyon

Altın Üye
Katılım
10 Temmuz 2012
Mesajlar
2,543
Excel Vers. ve Dili
2021 LTSC TR
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:
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.
 
Geri
Üst