Aynı Verinin Üzerine Kayıt Yaptırmak

[ormann]

İyi günler ekteki dosyada ana sayfa üzerinde bulunan izin günlerini aktar butonuna bastığımda ana sayfa üzerindeki veriler izin takibi sayfasına aktarılıyor.Benim istediğim ana sayfada e3 hücresindeki verilerin aynısı izin takibi sayfasında D sutununda var ise üzerine kayıt yaptırabilirmizi?

 

[Huseyinkis]

Merhaba ekteki kodları denermisiniz..

Aynı kayıtların üzerine veri yazarken İsim ve izin başlangıç tarihlerini baz alır.
Eğer kişinin izin başlangıç tarihini değiştirecek bir düzeltme yapıcaksanız kodların değiştirilmesi gerekir.

Option Explicit
Private Sub CommandButton1_Click()
Dim STR As Long, SR As Variant, SR1 As Variant
Dim i As Integer
Dim SYF As Worksheet
Set SYF = Sheets("İZİN TAKİBİ")
SR = MsgBox("Kayıt Yapılsın Mı_?", vbYesNo, "SORU")

For i = 4 To SYF.Cells(Rows.Count, 4).End(3).Row
If Cells(3, 5).Value = SYF.Cells(i, 4).Value And Cells(11, 5).Value = SYF.Cells(i, 7).Value Then
SR1 = MsgBox("Aynı Kayıt Mevcut Kayıt Yenilensin Mi?", vbYesNo, "SORU")
If SR1 = vbYes Then
STR = i
End If
End If
Next

If STR = 0 Then
STR = SYF.Range("D" & Rows.Count).End(xlUp).Row + 1
End If

If SR = vbNo Or SR1 = vbNo Then Exit Sub
Application.ScreenUpdating = False
SYF.Cells(STR, "D") = Range("E3")
SYF.Cells(STR, "E") = Range("E4")
SYF.Cells(STR, "F") = Range("E10")
SYF.Cells(STR, "G") = Range("E11")
SYF.Cells(STR, "H") = Range("E12")
SYF.Cells(STR, "I") = Range("E15")
SYF.Range("C4") = 1
SYF.Range("C4:C" & STR).DataSeries xlColumns, xlLinear, xlDay, 1, , False
Application.ScreenUpdating = True
MsgBox Range("E3") & " Verileri Aktarıldı", vbInformation
End Sub

 

[ormann]

Teşekkür ederim.Sayın Hüseyin bey