Hücreye Değer Girildiğinde Saat Ataması

[giwara]

Merhaba arkadaşlar,

Elimizdeki dosyada A hücresine değer girdiğimizde C hücresine saati atamamız gerekiyor. Ve bu saatin değişmemesi yani sabit kalması gerekiyor.

Böyle bir kod normal excel dosyasında çalışıyor. Fakat bizim kullandığımız sistemde maalesef kodu çalıştıramıyoruz.

Private Sub Worksheet_Change(ByVal Target As Range)
If Not Intersect(Target, [A1:A65536]) Is Nothing Then Cells(Target.Row, "B") = Format(Now, "hh:mm")
If Not Intersect(Target, [C1:C65536]) Is Nothing Then Cells(Target.Row, "D") = Format(Now, "hh:mm")
End Sub

[A1:A65536] kodunda sıkıntı veriyor. Biz de başka kod bulduk.

Option Explicit

Private Sub Worksheet_Change(ByVal Target As Range)
    If Not Intersect(Target, Columns("G"), Target.Parent.UsedRange) Is Nothing Then
        On Error GoTo Safe_Exit
        Application.EnableEvents = False
        Dim rng As Range
        For Each rng In Intersect(Target, Columns("G"), Target.Parent.UsedRange)
            If CBool(Len(rng.Value2)) And Not CBool(Len(rng.Offset(0, 1).Value2)) Then
                rng.Offset(0, 1) = Now
                 ElseIf Not CBool(Len(rng.Value2)) And CBool(Len(rng.Offset(0, 1).Value2)) Then
                rng.Offset(0, 1) = vbNullString
            End If
        Next rng
    End If
Safe_Exit:
    Application.EnableEvents = True
End Sub

Şu anda kullandığımız kod bu. Ve bu kod sistemimizde sorunsuz çalışıyor. Bu kodda G satırından birine değer girdiğimizde H hücresinde saat yazıyor.

Bizim sıkıntımız ise G'ye değer girdiğimizde mesela I hücresine yazmasını istiyoruz.
İkinci sıkıntımız ise bu saat yazma işlemini farklı farklı sütunlarda gerçekleştirebilmemiz mümkün müdür? Mesela G'ye yazdık I'da çıktı. J'ye değer girip K'da saat yazdırabilir miyiz? Yani aynı işlemi başka sütunlarda da gerçekleştirmek istiyoruz.

Bu kodu çoğaltmayı denedim ama başaramadım. Yardımcı olabilecek biri var mıdır?

 

[muygun]

Merhaba;
" Biz de başka kod bulduk." dediğiniz kodda;
Columns("G")
İbaresi kodların hangi sütun için işlem yapacağını belirtir. (siz bu harfi ihtiyacınıza göre tanımlayın)
Offset(0, 1)
İbaresinde 1 rakamı ise işlem yaptığınız sütundan sonraki yazacağı alanı belirler.
Yani G sütununda işlem yapıyorsanız yazacağı alan aynı satırda bir sonraki sütun (yani "H" sütunu) demektir.
Bu rakamı artırarak yada eksilterek istediğiniz alana yazdırabilirsiniz.
Offset(0, 2) G sütunundan 2 sonraki sütun
Offset(0, -2) G sütunundan 2 önceki sütun
gibi...

İyi çalışmalar

 

[giwara]

Çok teşekkürler.

Bu kodu 2. veya 3.defa kullanma şansımız var mı? A sütununa girdiğimizde C sütununda saat yazıyor. Ama D'ye herhangi veri girdiğimizde F sütunundan da saat yazılmasını istiyoruz.

 

[muygun]

Merhaba;
Sayfanın kod bölümüne;

Private Sub Worksheet_Change(ByVal Target As Range)

If Not Intersect(Target, Columns("A"), Target.Parent.UsedRange) Is Nothing Then
Application.EnableEvents = False
For Each rng In Intersect(Target, Columns("A"), Target.Parent.UsedRange)
If CBool(Len(rng.Value2)) And Not CBool(Len(rng.Offset(0, 2).Value2)) Then
rng.Offset(0, 2) = Now
ElseIf Not CBool(Len(rng.Value2)) And CBool(Len(rng.Offset(0, 2).Value2)) Then
rng.Offset(0, 2) = vbNullString
End If
Next rng
End If

If Not Intersect(Target, Columns("D"), Target.Parent.UsedRange) Is Nothing Then
Application.EnableEvents = False
For Each rng In Intersect(Target, Columns("D"), Target.Parent.UsedRange)
If CBool(Len(rng.Value2)) And Not CBool(Len(rng.Offset(0, 2).Value2)) Then
rng.Offset(0, 2) = Now
ElseIf Not CBool(Len(rng.Value2)) And CBool(Len(rng.Offset(0, 2).Value2)) Then
rng.Offset(0, 2) = vbNullString
End If
Next rng
End If

Application.EnableEvents = True
End Sub

Şeklinde kodları yerleştirerek deneyin.
Başka bir sütun için
If Not
ile başlayıp,
End If
ile biten aralığı kopyalayın ve ;
End If
satırından sonra yapıştırın.
Sonrada sütun adını isteğe göre değiştirin.

İyi çalışmalar.

 

[giwara]

Çok teşekkürler ellerine sağlık.

 

[giwara]

Son bir sıkıntımız kaldı. Sırala işlemini kullandığımız için saatler kayıyor. Sırala işlemini bu formülün içine nasıl dahil edebiliriz?

Mesela A B C D E F hücrelerin sıralıyoruz. Gün içinde sıralama sürekli değişiyor. Ama saat sütununa sırala eklediğimizde formül çalışmaz hale geliyor. Sırala fonksiyonu koymadığımızda da saatler kayıyor.

Nasıl çözüm yolu bulabiliriz?

 

[giwara]

Merhaba arkadaşlar yukarıdaki kodu google sheets üzerinde kullanabilir miyiz?