Çözüldü Koşula Bağlı Hücre İçeriğine tarih yazsın veya silsin

[ptcsite]

Aşağıdaki resimde görüldüğü gibi C hücresine veri girişi olunca D hücresinde tarih yazıyor. Bu makro çalışıyor ama C hücresindeki veriyi silince tarih silinmiyor.
Kodum aşağıdaki gibi sonuna Next yapınca döngü sonsuzlanıp kitleniyor.

Private Sub Worksheet_Change(ByVal Target As Range)


If Not Intersect(Target, [C9:C38]) Is Nothing Then Cells(Target.Row, "D") = Format(Now, "dd.mm.yyyy")


End Sub

Private Sub Tarih()
'Updateby ExtendOffice
 Dim xC_Sutun As Range
 Dim xD_Sutun As Range
 Dim xHucreC As Range
 Dim xHucreD As Range

 Set xC_Sutun = Application.Range("C9:C38")
 Set xD_Sutun = Application.Range("D9:D38")

 For Each xHucreC In xC_Sutun
 For Each xHucreD In xD_Sutun
 If xHucreC.Value = 0 Then
 xHucreD.ClearContents
 End If
 Next xHucreC
 Next xHucreD
End Sub

Asıl dosya ektedir.

 

[Necdet]

Merhaba,
Tarih Sub'ı neden yazdınız bilmiyorum, açıklarsanız yorum yapabiliriz.

Worksheet.change olayı yeterli gibi.

Private Sub Worksheet_Change(ByVal Target As Range)

If Intersect(Target, [C9:C38]) Is Nothing Then Exit Sub
If Target.Value = "" Then
    Target.Offset(0, 1).ClearContents
Else
    Target.Offset(0, 1) = Date
End If

End Sub

 

[ptcsite]

Merhaba,
Tarih Sub'ı neden yazdınız bilmiyorum, açıklarsanız yorum yapabiliriz.

Worksheet.change olayı yeterli gibi.

Private Sub Worksheet_Change(ByVal Target As Range)

If Intersect(Target, [C9:C38]) Is Nothing Then Exit Sub
If Target.Value = "" Then
    Target.Offset(0, 1).ClearContents
Else
    Target.Offset(0, 1) = Date
End If

End Sub

Kodlamaya sizin kadar hakim değilim,
"Private Sub Worksheet_Change(ByVal Target As Range)"
içerisinde 3 tane formulasyon olunca sıkıntı çıkar mı diye böyle birşeye giriştim. Bu kodu da internetten yabancı bir siteden bulup kendime uyarlamıştım...
Çok teşekkür ederim formulasyonları birlikte yazdım sizin sayenizde ve mantığını daha iyi anladım.

Olay çözülmüştür hemde çok güzel oldu... Teşekkür ederim.