- Katılım
- 19 Eylül 2023
- Mesajlar
- 18
- Excel Vers. ve Dili
- Microsoft Office LTSC Professional Plus 2021 bit
- Altın Üyelik Bitiş Tarihi
- 19-09-2024
DOSYA İndirmek/Yüklemek için ÜCRETLİ ALTIN ÜYELİK Gereklidir!
Altın Üyelik Hakkında Bilgi
Option Explicit
Private Sub Worksheet_Change(ByVal Target As Range)
Dim Rng As Range
If Intersect(Target, Range("C6:C36,N6:N36")) Is Nothing Then Exit Sub
For Each Rng In Intersect(Target, Range("C6:C36,N6:N36"))
If Rng.Value <> "" Then
Rng.Offset(, -1) = Now
Rng.Offset(, -1).NumberFormat = "d/mm/yyyy hh:mm:ss"
Rng.Offset(, -1).EntireColumn.AutoFit
Else
Rng.Offset(, -1) = ""
End If
Next
End Sub
Private Sub Workbook_SheetChange(ByVal Sh As Object, ByVal Target As Range)
Dim ws As Worksheet
Dim Cell As Range
If Sh.Name = "1" Or Sh.Name = "2" Or Sh.Name = "3" Then
If Not Intersect(Target, Sh.Columns("C")) Is Nothing Or Not Intersect(Target, Sh.Columns("N")) Is Nothing Then
Application.EnableEvents = False
For Each Cell In Target
If Not IsEmpty(Cell.Value) Then
If Cell.Column = 3 Then
Sh.Cells(Cell.Row, 2).Value = Date
ElseIf Cell.Column = 14 Then
Sh.Cells(Cell.Row, 13).Value = Date
End If
End If
Next Cell
Application.EnableEvents = True
End If
End If
End Sub
Private Sub Workbook_SheetChange(ByVal Sh As Object, ByVal Target As Range)
Dim Sayfalar() As Variant
Dim Sayfa As Variant
If Target.Text <> "" Then
Application.EnableEvents = False
Sayfalar = Array("1", "2", "3")
For Each Sayfa In Sayfalar
If Sh.Name = Sayfa Then
If Not Intersect(Range("C:C"), Target) Is Nothing Then
Cells(Target.Row, "B") = Date
ElseIf Not Intersect(Range("N:N"), Target) Is Nothing Then
Cells(Target.Row, "M") = Date
End If
Exit For
End If
Next
Application.EnableEvents = True
End If
End Sub
Sayfalar = Array("1", "2", "3")
bu satırda olduğu gibi ekleyebilirsiniz. Buraya adını eklemediğiniz sayfalarda kod çalışmaz.TeşekkürlerMerhaba,
Bu işlem için makro kullanmanız gerekir.
Aşağıdaki kodu işlemi yapmak istediğiniz sayfanın kod bölümüne uygulayıp deneyiniz. İlgili alanlara veri girdiğinizde Tarih ve saat olarak sonuç verecektir. İlgili alandaki veriler silindiğinde tarihlerde silinecektir.
C++:Option Explicit Private Sub Worksheet_Change(ByVal Target As Range) Dim Rng As Range If Intersect(Target, Range("C6:C36,N6:N36")) Is Nothing Then Exit Sub For Each Rng In Intersect(Target, Range("C6:C36,N6:N36")) If Rng.Value <> "" Then Rng.Offset(, -1) = Now Rng.Offset(, -1).NumberFormat = "d/mm/yyyy hh:mm:ss" Rng.Offset(, -1).EntireColumn.AutoFit Else Rng.Offset(, -1) = "" End If Next End Sub