Her hücrenin tarihi ve saati otomatik vermesi

[M.TMKÇ]

Merabalar.Ben vuslat_yolu rumuzlu kullanıcının sormuş olduğu sorunun aynısına ufak bi ekleme yaparak sormak istiyorum.

B hücrelerinde rakam olan bir sutunum var.F sutununda ise kayıt tarihi adlı bölüm var.

Ben B hücresine farklı zamanlarda kayıt eklediğimde f sutununda yer alan satırına o günün tarihini vermesini istiyorum.
Ve aşağı dogru kayıt işlemlerini yaptıkçada f sutununda kayıtın yapıldığı tarihleri görebilmek istiyorum.Ben bu işlemde saati de vermesini ve değişmemesini sabit kalmasını istiyorum ne yapmalıyım.
MAHİR ÇÜMEN BEY CEVAPLAMIŞ.
Lütfen kısa sürede yardımcı olabilirsen çok mutlu olurum.Şimdiden çok teşekkürler.

 

[Ömer BARAN]

Merhaba.

Alt tarafta uygulamayı kullanmak istediğiniz sayfa adına fareyle sağ tıklayıp KOD GÖRÜNTÜLEyi seçin.
Açılan VBA ekranında sağ taraftaki boş alana aşağıdaki kod'u yapıştırın.
F sütununun biçimin İSTEĞE UYARLANMIŞ kısmından gg.aa.yyyy ss:dd:nn

NOT: B sütununda ki bir hücreye bir veri yazıldıktan sonra
(veri yazıldığında F sütununa tarih/saat yazılmış durumda)
B sütunundaki veri silindiğinde F sütununda daha önce yazılmış olan
tarih/saat bilgisinin de silinmesini istemiyorsanız aşağıdaki kırmızı satır silin.
.

[FONT="Arial Narrow"]Private Sub Worksheet_Change(ByVal Target As Range)
If Intersect(Target, [B1:B65536]) Is Nothing Then Exit Sub
If Cells(Target.Row, 2) <> "" Then Cells(Target.Row, "F") = Now
[COLOR="Red"]If Target = "" And Cells(Target.Row, "F") <> "" Then Cells(Target.Row, "F") = ""[/COLOR]
End Sub[/FONT]

 

[Merhum İdris SERDAR]

.

Alternatif:

Private Sub Worksheet_Change(ByVal Target As Excel.Range)
        
        With Target
            If .Count > 2 Then Exit Sub
            If Not Intersect(Range("B2:B200"), .Cells) Is Nothing Then
                Application.EnableEvents = False
                If IsEmpty(.Value) Then
                    .Offset(0, 4).ClearContents
                Else
                    With .Offset(0, 4)
                        .NumberFormat = "dd mm yyyy hh:mm:ss"
                        .Value = Now
                    End With
                End If
                Application.EnableEvents = True
            End If
        End With
    
    End Sub

.