• FORUMU MOBİL UYGULAMADAN TAKİP EDİN

    Forumu isteyen üyelerimiz Tapatalk (Harici bir hizmet) üzerinden mobil uygulamadan takip edebilirler.
    iOS için : https://itunes.apple.com/app/id307880732?mt=8
    Android için : https://play.google.com/store/apps/details?id=com.quoord.tapatalkpro.activity
    adreslerinden indirebilirsiniz.

    Bir iki haftaya da foruma özel kendi uygulamamız yayında olacak.
ALTIN ÜYELİK Hakkında Bilgi
-----------------------

Tarih ve saat

ASLAN7410

Altın Üye
Altın Üye
Katılım
15 Temmuz 2012
Mesajlar
2,079
Beğeniler
19
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,317
Beğeniler
27
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,079
Beğeniler
19
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,317
Beğeniler
27
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,079
Beğeniler
19
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,079
Beğeniler
19
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,079
Beğeniler
19
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
 
Üst