Otomatik tarih atma

[kontto]

Merhaba arkadaşlar,
C2 sütununa veri girdiğim zaman P2 sütununa girdiğim günün tarihini otomatik olarak atmasını istiyorum. (veri giriş sayısı 10000 kadar gidebilir.Yani C2,C3,C4,...... P2,P3,P4..... gibi) Ancak bir sonraki gün yine veri girersem yine veriyi girdiğim günün tarihine atacak fakat bir önceki gün girmiş olduğum veri için o gün atılan tarih bir sonraki gün artmayacak, yani veriyi hangi gün girersem sadece o günün tarihini atacak ve tarih o gün de kalacak,
Örnek: bugün girdiğim bir veri için 02/09/2014, dün girdiğim verinin tarihi 01/09/2014 te kalacak şekilde, umarım yardımcı olursunuz. Şimdiden teşekkür ederim.

 

[YUSUF44]

Aşağıdaki kodları ilgili sayfanın kod bölümüne yapıştırıp deneyiniz:

Private Sub Worksheet_Change(ByVal Target As Range)
If Intersect(Target, [C:C]) Is Nothing Then Exit Sub
Target.Offset(0, 13) = Date
End Sub

ilgili sayfanın kod bölümüne gitme:

 

[kontto]

Emeğinize sağlık teşekkür ederim. Sağolun

 

[TUNCA ERSİN]

Sy. @YUSUF44 ;
Private Sub Worksheet_Change(ByVal Target As Range)
If Intersect(Target, [C:C]) Is Nothing Then Exit Sub
Target.Offset(0, 13) = Date
End Sub

Hocam bu kod veriyi elle girince tarih atıyor . A sütununa kopyala yapıştır değince yapması için ne yapa biliriz.
teşekkürler.

 

[YUSUF44]

Sy. @YUSUF44 ;
Private Sub Worksheet_Change(ByVal Target As Range)
If Intersect(Target, [C:C]) Is Nothing Then Exit Sub
Target.Offset(0, 13) = Date
End Sub

Hocam bu kod veriyi elle girince tarih atıyor . A sütununa kopyala yapıştır değince yapması için ne yapa biliriz.
teşekkürler.

Aşağıdaki gibi dener misiniz?

Private Sub Worksheet_Change(ByVal Target As Range)
If Intersect(Target, [C:C]) Is Nothing Then Exit Sub
Target.Offset(0, 13) = Date
If Selection.Count > 1 Then
Selection.Offset(0, 13) = Date
End If
End Sub

 

[TUNCA ERSİN]

Sy. @YUSUF44 ;
hocam B sütunundan K sütununa kopyala yapıştır yapınca aşağıdaki gibi oldu tarih ve saati sadece K sütununa nasıl yazdıra biliriz.

 

[YUSUF44]

Dosyayı o haliyle paylaşır mısınız?

 

[TUNCA ERSİN]

Sy. @YUSUF44 ;
Buyurun hocam

 

[YUSUF44]

Aşağıdaki gibi deneyin:

Private Sub Worksheet_Change(ByVal Target As Range)
If Intersect(Target, [b:b]) Is Nothing Then Exit Sub
If Selection.Count > 1 Then
    a = Selection.Rows.Count
    b = Selection.Row
    For i = b To b + a - 1
        Cells(i, "M") = Date
    Next
Else
    Target.Offset(0, 13) = Date
End If
End Sub

 

[TUNCA ERSİN]

Sy. @YUSUF44 ;
hocam elinize sağlı çok güzel olmuş bir tek saat dakika nasıl ekleye biliriz. teşekkür ederim.

 

[YUSUF44]

Koddaki Date ifadeleri yerine Now kullanabilirsiniz.

 

[TUNCA ERSİN]

Sy. @YUSUF44 ;

teşekkür ederim hocam elinize sağlık çok güzel oldu

 

[TUNCA ERSİN]

Sy. @YUSUF44 ;
Hocam bu koda bir ekleme daha yapabilir miyiz. L sütununa İŞLE yaza bilir mi ? Teşekkür ederim.

Private Sub Worksheet_Change(ByVal Target As Range)
If Intersect(Target, [b:b]) Is Nothing Then Exit Sub
If Selection.Count > 1 Then
a = Selection.Rows.Count
b = Selection.Row
For i = b To b + a - 1
Cells(i, "M") = Date
Next
Else
Target.Offset(0, 13) = Date
End If
End Sub

 

[YUSUF44]

Deneyiniz:

Private Sub Worksheet_Change(ByVal Target As Range)
If Intersect(Target, [b:b]) Is Nothing Then Exit Sub
If Selection.Count > 1 Then
    a = Selection.Rows.Count
    b = Selection.Row
    For i = b To b + a - 1
        Cells(i, "M") = Date
        Cells(i, "L") = "İşle"
    Next
Else
    Target.Offset(0, 13) = Date
    Target.Offset(0, 12) = "İşle"
End If
End Sub

 

[TUNCA ERSİN]

Sy. @YUSUF44 ;
Teşekkür ederim hocam.

 

[TUNCA ERSİN]

Sy. @YUSUF44 ;
Hocam sizden bir ricam daha var düşayarada da bu uygulama yapıla bilir mi ?

 

[YUSUF44]

Çözemedim maalesef.

 

[TUNCA ERSİN]

Sy. @YUSUF44 ;
Tamam hocam teşekkür ederim. iyi günler