Formüle bağlı hücre değiştiğinde tarih yazması

[barmen2169]

Webden veri çektiğim bir excel sayfam var. Burada dakika başı verileri güncelliyor. H:H sutununda değişiklik olduyğunda yanına tarih yazmasını istiyorum. Fakat H:H sutunundaki değerler formul ile alıyor. Aşağıdaki kod veriler yenilendiğinde çalışmıyor. Örneğin H5 hücresini elle değiştirdiğimde kod çalışıyor. Bunu nasıl çözebilirim yardım edebilir misiniz ?

Sub Worksheet_Change(ByVal Target As Range)
If Intersect(Target, [H:H]) Is Nothing Then Exit Sub
Application.EnableEvents = False
Target.Offset(0, 1) = Now
Application.EnableEvents = True
End Sub

 

[Ömer]

Merhaba,

Başlık satırı yerine;

Private Sub Worksheet_Calculate()

yazarak deneyin.

.

 

[barmen2169]

Private Sub Worksheet_Calculate()
If Intersect(target, [D:D]) Is Nothing Then Exit Sub
Application.EnableEvents = False
target.Offset(0, 1) = Now
Application.EnableEvents = True
End Sub

olarak denediğimde Runtime error '424' hatası veriyor

 

[Ömer]

Küçük bir örnek ile detaylı açıklarsanız daha net yanıtlar alabilirsiniz.

İstediğiniz bu mu?

Private Sub Worksheet_Calculate()

    Application.EnableEvents = False
    Range("D:D").SpecialCells(xlCellTypeFormulas, 23).Offset(0, 1) = Now
    Application.EnableEvents = True
    
End Sub

.

 

[barmen2169]

Dosyayı paylaşırsam sanırım daha kolay olur. İstediğim D2 ve D26 hücre aralığındaki değerler değiştiği anda yanındaki hücreye o anki tarih saati yazmasını istiyorum.
Ek dosya

 

[barmen2169]

Küçük bir örnek ile detaylı açıklarsanız daha net yanıtlar alabilirsiniz.

İstediğiniz bu mu?

Private Sub Worksheet_Calculate()

    Application.EnableEvents = False
    Range("D:D").SpecialCells(xlCellTypeFormulas, 23).Offset(0, 1) = Now
    Application.EnableEvents = True
    
End Sub

.

Bu kod ile D sutunundaki tüm değerlerin yanına tarih saat ekliyor. Ama ben sadece değişen değerin yanındaki hücreye tarih saat yazdırmak istiyorum.

 

[barmen2169]

Eki inceleyip yardım edebilecek kimse yok mu?

 

[Ömer]

Module kopyalayın. Bir kere çalıştırın. Daha sonra dosya açılışında çalışacaktır. IV sütunu yardımcı sütun olarak belirlendi. Siz değiştirebilirsiniz.

Sub Auto_Open()

    [D:D].Copy
    [IV1].PasteSpecial Paste:=xlPasteValues, Operation:=xlNone
    Application.CutCopyMode = False
    
    [D1].Select
    
End Sub

Sayfanın kod bölümüne kopyalayın.

Private Sub Worksheet_Calculate()
    
    Application.ScreenUpdating = False
    Dim i As Long
    
    For i = 1 To Cells(Rows.Count, "D").End(xlUp).Row
        If Cells(i, "D") <> Cells(i, "IV") Then
            Cells(i, "E") = Now
        End If
    Next i
    
    [D:D].Copy
    [IV1].PasteSpecial Paste:=xlPasteValues, Operation:=xlNone
    Application.CutCopyMode = False
    
    [D1].Select
    
    Application.ScreenUpdating = True
    
End Sub

.

 

[barmen2169]

Ömer Bey çok teşekkür ederim elinize sağlık. Tam istediğim gibi oldu şuanda teşekkür ederim.