Tarih Değişmesin..!

[sensizsoldum]

Merhaba,
Koddaki aşağıdaki kodda, çözüm için sizlerden yardım almam gerekli.
B3:B aralığına herhangi bir veri girildiğinde, A sütunu yan hücresinde o anki tarihi yazıyor. Ancak sayfaya satır sil ve satır ekle yapıldığında tüm verilere ait tarih, 01.01.1900 oluyor. Bu işlem neden tarihi değiştiriyor. Anlamadım. Girilen kayıtlara ait tarihler öyle kalmalı. 8 aylık çalışmanın tarihlerini girmek 2 günden fazla zamanımı alacak, öncelikle bu soruna bir çözüm bulmamız lazım. Yardımlarınız için teşekkür ederim.
İyi çalışmalar dilerim.










Private Sub Worksheet_Change(ByVal Target As Range)
Dim Satir As Long

If Intersect(Target, Range("B3:B" & Rows.Count)) Is Nothing Then Exit Sub

Application.ScreenUpdating = False
Application.EnableEvents = False

If Target.Count = 1 Then
If Target <> Empty Then
Cells(Target.Row, "A") = Date
Else
Cells(Target.Row, "A") = Empty
End If
ElseIf Target.Count > 1 Then
Satir = Cells(Rows.Count, 1).End(3).Row
If Satir >= 3 Then
With Range("A3:A" & Satir)
.Formula = "=IF(B3="""","""",1)"
.Value = .Value
End With
End If
End If

Application.EnableEvents = True
Application.ScreenUpdating = True
End Sub

 

[muygun]

Merhaba;
mevcut kodları silerek sayfanın kod bölümüne;

Private Sub Worksheet_Change(ByVal Target As Range)
If Intersect(Target, [B3:B65536]) Is Nothing Then Exit Sub
If Target.Cells.Count > 1 Then GoTo Son
On Error Resume Next
If Target <> Empty Then
Application.EnableEvents = False
Target.Offset(0, -1).Value = Date
Target.Offset(0, -1).NumberFormat = "dd.mm.yyyy"
End If
Son: Application.EnableEvents = True
End Sub

Kodlarını ekleyin.
İyi çalışmalar.

Not: Kodlar alıntıdır.

 

[sensizsoldum]

Merhaba Sayın Muygun,

 

[sensizsoldum]

Merhaba Sayın Muygun,
İlginiz için çok teşekkür ederim. bir küçük değişiklik yapabilmemiz mümkün mü?
B sütuna veri girildiğinde tarih yazıyor, fakat veriyi tekrardan sildiğimizde tarih kalıcı oluyor. Bunun da silinmesini sağlaya bilir miyiz?
Tekrardan Teşekkür ederim. İyi çalışmalar dilerim.
Saygılarımla.

 

[muygun]

Merhaba;
Kodları ;

Private Sub Worksheet_Change(ByVal Target As Range)
If Intersect(Target, [B3:B65536]) Is Nothing Then Exit Sub
If Target.Cells.Count > 1 Then GoTo Son
On Error Resume Next
If Target = "" Then Target.Offset(0, -1).Value = ""
If Target <> Empty Then
Application.EnableEvents = False
Target.Offset(0, -1).Value = Date
Target.Offset(0, -1).NumberFormat = "dd.mm.yyyy"
End If
Son: Application.EnableEvents = True
End Sub

şeklinde uygulayın.

Not:Yanlışlıkla delete tuşuna basma yada B sütununda ilgili veriyi düzeltmek için sildiğiniz zaman A sütunundaki tarih silinecektir.(bence riskli bir kullanım yöntemi)
B sütunundan veriyi sildikten sonra tarihi manuel silmek daha kontrollü. Ama kullanım tercihi sizin...
İyi çalışmalar.