DOSYA İndirmek/Yüklemek için ÜCRETLİ ALTIN ÜYELİK Gereklidir!
Altın Üyelik Hakkında Bilgi
Private Sub Worksheet_Change(ByVal Target As Range)
If Intersect(Target, [b14:e65536]) Is Nothing Then Exit Sub
sat1 = Target.Row
If Target.Column < 4 Then Cells(sat1, "a") = Now
If Target.Column > 3 Then Cells(sat1, "f") = Now
End Sub
Çalışma sayfanızın kod sayfasına aşağıdaki kodları yazın.
A ve F sütununu Saat olarak biçimlendirin.
Tarih olarak biçimlerseniz Günün tarihini de yazar.
Kod:Private Sub Worksheet_Change(ByVal Target As Range) If Intersect(Target, [b14:e65536]) Is Nothing Then Exit Sub sat1 = Target.Row If Target.Column < 4 Then Cells(sat1, "a") = Now If Target.Column > 3 Then Cells(sat1, "f") = Now End Sub
Rica ederim.
İyi çalışmalar dilerim.
Mesela 15 farklı hücreye girildiğinde giriş saatine atıcak bir başka 15 sütuna girilince de çıkış saatine atıcak aynı satır üzerinde yapıcak bunu ayrıca
Sayın ozgurpeh
Makro B C D ve E sütunlarında Hücre bazında çalışmaktadır.
Bu ifadenizle ne demek istediğini anladığımı söyleyemeyeceğim.
Konuyu biraz daha açarmısınız?
B veya C Sütununa herhanbir bir şey yazılınca (örnekxxx) Giriş saatini yazıldığı anki sistem saatini esas alacak şekilde atması ve D-E sütununa değer girilincede yine o ankii saati çıkış saati kısmına nasıl atabiliriz.? (giriş ve çıkış farklı saatler olucak)
ben bunu 15 tana yan yana hücreye girdiğimde girişe atsın hemen peşi sıra gelen 15 hücreye girildiği zamanda çıkışa atsın toplam 30 sütün
Private Sub Worksheet_Change(ByVal Target As Range)
If Intersect(Target, [b14:ae65536]) Is Nothing Then Exit Sub
sat1 = Target.Row
If Target.Column < 17 Then Cells(sat1, "a") = Now
If Target.Column > 16 Then Cells(sat1, "af") = Now
End Sub
Dosyanızdaki mesaj bu.
Eğer böyle demekle
B sütunundan P sütununa kadar veri girince A sütununa tarih atsın, Q sütunudan AE sütununa kadar veri girince AF sütununa mı tarih atsın demek istiyorsunuz.
Eğer öyleyse kodu şöyle değiştirin. Değilse örnek dosya ile izah edin.
Kod:Private Sub Worksheet_Change(ByVal Target As Range) If Intersect(Target, [b14:e65536]) Is Nothing Then Exit Sub sat1 = Target.Row If Target.Column < 17 Then Cells(sat1, "a") = Now If Target.Column > 16 Then Cells(sat1, "af") = Now End Sub
Private Sub Worksheet_Change(ByVal Target As Range)
If Intersect(Target, [[COLOR=red][B]D3[/B][/COLOR]:aq65536]) Is Nothing Then Exit Sub
sat1 = Target.Row
If Target.Column < 18 Then Cells(sat1, "c") = Now
If Target.Column > 18 Then Cells(sat1, "ar") = Now
End Sub