Tarih ve saat

ASLAN7410

Altın Üye
Altın Üye
Katılım
15 Temmuz 2012
Mesajlar
2,147
Beğeniler
23
Excel Vers. ve Dili
Ofis 2013 Türkçe
#1
Merhaba hayırlı geceler.

Ekte gönderdiğim excel dosyamın sayfanın kod bölümünde aşağıdaki kod var, kod E ve F sütununda çift tıkladığında tarih ve saat atıyor, bu sütunlarda dolu olan hücrelerde tekrar tıklandığında tarih ve saat atmıyor, kodlar tam istediğim gibi gayet güzel çalışıyor.

Ben bu kodu Private Sub Worksheet_Change(ByVal Target As Range) bu başlık altında çalıştırmaya çalıştım ama yapamadım.

Yapmak istediğim B2 sütunundan aşağıya doğru bilgi girdiğimde C sütunundaki ilgili hücreye tarih, D sütunundaki ilgili hücreye saat atmasını ve A sütununa sıra no vermesini istiyorum istiyorum.

Yardımcı olur musunuz?

Kod:
Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)
On Error Resume Next
If Not Target.Column <> 5 Then
If IsDate(Target.Value) = False Then
    Target.Value = Format(Now, "dd.mm.yyyy")
End If
End If
If Target.Column <> 6 Then Exit Sub
If IsTime(Format(Target.Value, "hh:mm")) = False Then
    Target.Value = Format(Now, "hh:mm")
End If
End Sub
Function IsTime(str)
  If str = "" Then
    IsTime = False
  Else
    On Error Resume Next
    TimeValue (str)
    If Err.Number = 0 Then
      IsTime = True
    Else
      IsTime = False
    End If
    On Error GoTo 0
  End If
End Function
 

Ekli dosyalar

askm

Altın Üye
Altın Üye
Katılım
4 Haziran 2005
Mesajlar
2,480
Beğeniler
54
Excel Vers. ve Dili
2010-2016
#2
Aşağıdaki şekilde deneyin. Tarih ve saat varsa işlem yapma demişsiniz.
Kod:
Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)
On Error Resume Next
If Not Target.Column <> 5 Then
'If IsDate(Target.Value) = False Then
    Target.Value = Format(Now, "dd.mm.yyyy")
'End If
End If
If Target.Column <> 6 Then Exit Sub
'If IsTime(Format(Target.Value, "hh:mm")) = False Then
    Target.Value = Format(Now, "hh:mm")
'End If
End Sub
 

ASLAN7410

Altın Üye
Altın Üye
Katılım
15 Temmuz 2012
Mesajlar
2,147
Beğeniler
23
Excel Vers. ve Dili
Ofis 2013 Türkçe
#3
Sayın askm, ilginiz için çok teşekkür ediyorum, bu kodu zaten daha önceden siz göndermiştiniz, çok teşekkür ediyorum. Kodda bir sıkıntı yok zaten.

Göndermiş olduğum örnekte B2 sütunundan aşağıya doğru bilgi girdiğimde C sütunundaki ilgili hücreye tarih, D sütunundaki ilgili hücreye saat atmasını ve A sütununa sıra no vermesini istiyorum istiyorum. Bu kodun Private Sub Worksheet_Change(ByVal Target As Range) bu başlık altında bu şekilde çalışmasını istiyorum.
 

askm

Altın Üye
Altın Üye
Katılım
4 Haziran 2005
Mesajlar
2,480
Beğeniler
54
Excel Vers. ve Dili
2010-2016
#4
İsteğiniz aşağıdaki şekilde mi?
Kod:
Private Sub Worksheet_Change(ByVal Target As Range)
If Intersect(Target, [B:B]) Is Nothing Then Exit Sub
    On Error Resume Next
    If IsDate(Cells(Target.Row, "C").Value) = False Then
        Cells(Target.Row, "C").Value = Format(Now, "dd.mm.yyyy")
    End If

    If IsTime(Format(Cells(Target.Row, "C").Value, "hh:mm")) = False Then
        Cells(Target.Row, "D").Value = Format(Now, "hh:mm")
    End If

End Sub
 

ASLAN7410

Altın Üye
Altın Üye
Katılım
15 Temmuz 2012
Mesajlar
2,147
Beğeniler
23
Excel Vers. ve Dili
Ofis 2013 Türkçe
#5
Sayın askm, çok teşekkür ediyorum, ellerinize sağlık tam istediğim gibi oldu.

Hayırlı çalışmalar, hayırlı geceler diliyorum.

Kod:
Private Sub Worksheet_Change(ByVal Target As Range)
If Intersect(Target, [B:B]) Is Nothing Then Exit Sub
With Sheets(1).Range("A2:A" & Sheets(1).[B65536].End(3).Row)
    .Formula = "=Row()-1"
    .Value = .Value
End With
    On Error Resume Next
    If IsDate(Cells(Target.Row, "C").Value) = False Then
        Cells(Target.Row, "C").Value = Format(Now, "dd.mm.yyyy")
    End If

    If IsTime(Format(Cells(Target.Row, "D").Value, "hh:mm")) = False Then
        Cells(Target.Row, "D").Value = Format(Now, "hh:mm")
    End If
End Sub
Function IsTime(str)
  If str = "" Then
    IsTime = False
  Else
    On Error Resume Next
    TimeValue (str)
    If Err.Number = 0 Then
      IsTime = True
    Else
      IsTime = False
    End If
    On Error GoTo 0
  End If
End Function
 
Son düzenleme:

ASLAN7410

Altın Üye
Altın Üye
Katılım
15 Temmuz 2012
Mesajlar
2,147
Beğeniler
23
Excel Vers. ve Dili
Ofis 2013 Türkçe
#6
Bu mesaj silindi.
 
Son düzenleme:

ASLAN7410

Altın Üye
Altın Üye
Katılım
15 Temmuz 2012
Mesajlar
2,147
Beğeniler
23
Excel Vers. ve Dili
Ofis 2013 Türkçe
#7
Sayın askm, B sütununa bilgi girildiği zaman bu kodlar gayet güzel çalışıyor, ellerinize sağlık, H sütununa da aynı şekilde ASLAN yazmasını istiyorum, bunu da ekleyebilir misiniz?
 

ASLAN7410

Altın Üye
Altın Üye
Katılım
15 Temmuz 2012
Mesajlar
2,147
Beğeniler
23
Excel Vers. ve Dili
Ofis 2013 Türkçe
#8
Belki birinin işine yarar diye ekliyorum, aşağıdaki kodlar tam istediğim gibi çalışıyor.

Kod:
Private Sub Worksheet_Change(ByVal Target As Range)
If Intersect(Target, Range("B2:B" & Rows.Count)) Is Nothing Then Exit Sub

    With Sheets(1).Range("A2:A" & Sheets(1).[B65536].End(3).Row)
        .Formula = "=Row()-1"
        .Value = .Value
    End With
    
    On Error Resume Next
    If IsDate(Cells(Target.Row, "C").Value) = False Then
        Cells(Target.Row, "C").Value = Format(Now, "dd.mm.yyyy")
    End If

    If IsTime(Format(Cells(Target.Row, "D").Value, "hh:mm")) = False Then
        Cells(Target.Row, "D").Value = Format(Now, "hh:mm")
    End If
    
    If Cells(Target.Row, "H").Value = False Then
        Cells(Target.Row, "H").Value = "ASLAN"
    End If
End Sub
Function IsTime(str)
  If str = "" Then
    IsTime = False
  Else
    On Error Resume Next
    TimeValue (str)
    If Err.Number = 0 Then
      IsTime = True
    Else
      IsTime = False
    End If
    On Error GoTo 0
  End If
End Function
 
Katılım
29 Temmuz 2008
Mesajlar
85
Beğeniler
0
Excel Vers. ve Dili
türkce 2003
#9
selamun aleyküm bende böyle bir sorun var
mesela a1 hücresine veri girdiğimde b1 sütünuna saati atmasını istiyorum. yine aynı şekil c1 sutununa veri girdiğimde d1sütünuna saati atmasını istiyorum.e1 sutununa veri girdiğimde f1sütünuna saati atmasını istiyorum nasıl bir kod lazım yardımlarınızı bekliyorum
 

askm

Altın Üye
Altın Üye
Katılım
4 Haziran 2005
Mesajlar
2,480
Beğeniler
54
Excel Vers. ve Dili
2010-2016
#10
Kod:
Private Sub Worksheet_Change(ByVal Target As Range)
If IsTime(Format(Target.Value, "hh:mm")) = False Then
    Cells(Target.Row, Target.Column + 1).Value = Format(Now, "hh:mm")
End If

End Sub

Function IsTime(str)
  If str = "" Then
    IsTime = False
  Else
    On Error Resume Next
    TimeValue (str)
    If Err.Number = 0 Then
      IsTime = True
    Else
      IsTime = False
    End If
    On Error GoTo 0
  End If
End Function
 

Orion1

Uzman
Uzman
Katılım
1 Mart 2005
Mesajlar
20,950
Beğeniler
204
Excel Vers. ve Dili
Win7 Home Basic TR 64 Bit

Ofis-2010-TR 32 Bit
#11
selamun aleyküm bende böyle bir sorun var
mesela a1 hücresine veri girdiğimde b1 sütünuna saati atmasını istiyorum. yine aynı şekil c1 sutununa veri girdiğimde d1sütünuna saati atmasını istiyorum.e1 sutununa veri girdiğimde f1sütünuna saati atmasını istiyorum nasıl bir kod lazım yardımlarınızı bekliyorum
Buyurun.:cool:

Kod:
Private Sub Worksheet_Change(ByVal Target As Range)
If Intersect(Target, Range("A1,C1,E1")) Is Nothing Then Exit Sub
Target.Offset(0, 1).NumberFormat = "hh:mm:ss"
Target.Offset(0, 1).Value = Now
End Sub
 
Katılım
29 Temmuz 2008
Mesajlar
85
Beğeniler
0
Excel Vers. ve Dili
türkce 2003
#13
abiler yaptığımız yeri yani a1 hücresini sildiğimde yana doğru hep saat atıyor otomatik olarak
 

Orion1

Uzman
Uzman
Katılım
1 Mart 2005
Mesajlar
20,950
Beğeniler
204
Excel Vers. ve Dili
Win7 Home Basic TR 64 Bit

Ofis-2010-TR 32 Bit
#14
abiler yaptığımız yeri yani a1 hücresini sildiğimde yana doğru hep saat atıyor otomatik olarak
Buyurun.:cool:
Kod:
Private Sub Worksheet_Change(ByVal Target As Range)
If Intersect(Target, Range("A1,C1,E1")) Is Nothing Then Exit Sub
If Target.Value <> "" Then
    Target.Offset(0, 1).NumberFormat = "hh:mm:ss"
    Target.Offset(0, 1).Value = Now
End If
End Sub
 
Üst