• DİKKAT

    DOSYA İndirmek/Yüklemek için ÜCRETLİ ALTIN ÜYELİK Gereklidir!
    Altın Üyelik Hakkında Bilgi

Hücrede tarih ve saat varsa değişiklik yapmasın

Katılım
15 Temmuz 2012
Mesajlar
2,802
Excel Vers. ve Dili
Ofis 2021 TR 64 Bit
Merhaba hayırlı sabahlar hayırlı ramazanlar.

Ekte gönderdiğim excel dosyamın Sayfa1'de B ve C sütunlardaki hücrelere bilgi girildiğinde F sütununa tarih G sütununa saat atıyor.

Benim yapmak istediğim B ve C sütunundaki dolu olan hücrelerde değişiklik yapıldığında ilgili sütundaki tarih ve saatin değişmemesini istiyorum.

Yardımcı olur musunuz?

http://dosya.co/6ie4y597wtyl/Örnek1.xlsm.html
.
 

Ekli dosyalar

Son düzenleme:
Aşağıdaki kodu deneyin
Kod:
Dim test As Boolean
Private Sub Worksheet_Change(ByVal Target As Range)
On Error GoTo son
If Intersect(Target, [B2:C65536]) Is Nothing Then Exit Sub
If test = True Then
Cells(Target.Row, "F") = Format(Now, "dd.mm.yyyy")
Cells(Target.Row, "G") = Format(Now, "hh:mm:ss")
End If
Eski = WorksheetFunction.Max(2, Cells(Rows.Count, "A").End(3).Row)
b = WorksheetFunction.Max(2, Cells(Rows.Count, "B").End(3).Row)
c = WorksheetFunction.Max(2, Cells(Rows.Count, "C").End(3).Row)
Range("A2:A" & Eski).ClearContents
son = WorksheetFunction.Max(b, c)
For i = 2 To son
Cells(i, "A") = i - 1
Next

son:

On Error Resume Next
If Target.Value = "" Then Cells(Target.Row, "F") = ""
If Target.Value = "" Then Cells(Target.Row, "G") = ""
End Sub


Private Sub Worksheet_SelectionChange(ByVal Target As Range)
If Intersect(Target, [B2:C65536]) Is Nothing Then Exit Sub
If Len(Target) <> 0 Then
test = False
Else
test = True
End If
End Sub
 
Sayın Ali Bey, ellerinize sağlık tam istediğim gibi çalışıyor, çok teşekkür ederim.

Hayırlı sabahlar, hayırlı ramazanlar diliyorum.
 
Geri
Üst