Aynı sayfa da yan yana 2 hücede girilen verilere saat yazdırmak

[Cibali]

Sa...
Aynı sayfada 2 hücreye veri girişi yapıyorum,

Private Sub Worksheet_Change(ByVal Target As Range)
If Not Intersect(Target, [d1:A65536]) Is Nothing Then Cells(Target.Row, "f") = Format(Now, "hh:mm:ss")
If Not Intersect(Target, [N1:A65536]) Is Nothing Then Cells(Target.Row, "O") = Format(Now, "hh:mm:ss")
End Sub

sorum şu, d1 hücresine yazdığım değer hem f hem de O hücrelerinde saat yazıyor.
benim istediğim d1 yazdığım F hücresine, N1 yazdığım O hücresinde yazsın.
yardım lüütfen

 

[Necdet]

Merhaba,
Birinci satırı es geçtim, her halde bir başlık vardır düşüncesiyle.

Private Sub Worksheet_Change(ByVal Target As Range)

    If Intersect(Target, [D:D,N:N]) Is Nothing Or Target.Row < 2 Then Exit Sub
    
    If Target.Column = 4 Then
        Target.Offset(0, 2) = Time
    Else
        Target.Offset(0, 1) = Time
    End If
    
End Sub

 

[Cibali]

Hocam teşekkür ederim ama,
yazdığınız olmadı, bu benim formül de sorun O hücresine yazması

Private Sub Worksheet_Change(ByVal Target As Range)
If Not Intersect(Target, [d5:A65536]) Is Nothing Then Cells(Target.Row, "f") = Format(Now, "hh:mm:ss")
If Not Intersect(Target, [M5:A65536]) Is Nothing Then Cells(Target.Row, "O") = Format(Now, "hh:mm:ss")
End Sub

olmadı (

 

[Cibali]

Hocam ayrıca,

D5 hücresine yazdığım veriyi F hücresine yazıyor ama
M5 hücresine yazdığım O hücresine yazmıyor.
Dosyayı kapatıp açtığımda da kod siliniyor.

 

[Cibali]

Hocam,

Private Sub Worksheet_Change(ByVal Target As Range)

If Not Intersect(Target, [D565536]) Is Nothing Then Cells(Target.Row, "F") = Format(Now, "hh:mm:ss")
If Not Intersect(Target, [M5:M65536]) Is Nothing Then Cells(Target.Row, "O") = Format(Now, "hh:mm:ss")

End Sub


bu şekilde yazıyorum, çok güzel çalışıyor ama dosyayı kapatıp açtığımda kodlar silinmiş olyor.

nereye nasıl yazacam ve neden siliniyor (

 

[YUSUF44]

Dosyayı kaydederken Makro içerebilen Excel dosyası olarak kaydediniz. Uzantısı xlsm olacaktır. siz muhtemelen xlsx uzantılı Excel dosyası olarak kaydettiğiniz için makrolar siliniyordur.

 

[Cibali]

Sağolun hocam, sorun makrolu kayıt olayı imiş hallettim.

bir sorum daha var hocam, yazan ve yazılan hücreye renk ataması yapabilirmiyiz.

Private Sub Worksheet_Change(ByVal Target As Range)

If Intersect(Target, [D,M:M]) Is Nothing Or Target.Row < 2 Then Exit Sub

If Target.Column = 4 Then
Target.Offset(0, 2) = Time " 0-kırmızı . 2-mavi"
Else
Target.Offset(0, 2) = Time " 0-mor . 2-mavi"
End If

End Sub

 

[YUSUF44]

Hem bu sorunuzla hem de özel mesajla sorduğunuz soruyla ilgili olarak örnek bir dosya hazırlayıp dosya yükleme sitelerinden birine yükleyip burada paylaşırsanız daha kolay çözüm buluruz.