Satırda yazılan yazıdan sonra yan satırda otomatik tarih yazmasın

[latimera]

Üstadlar S.A

ek'teki dosyada B2 satırına yazılan yazıdan sonra A2 bugün tarihi yazılması hakkında yardımcı olabilirmisiniz.

 

[N.Ziya Hiçdurmaz]

yanıt

Sayfa kod bölümüne kodu ekleyiniz.

Private Sub Worksheet_Change(ByVal Target As Range)
    If Intersect(Target, [b:b]) Is Nothing Then Exit Sub
        Target.Offset(0, -1) = Date
End Sub

 

[latimera]

üstad özür dileyerek

modul ekledim ama hata verdi... ben yanlışlık yapmış olabilirim.

 

[N.Ziya Hiçdurmaz]

Sayfa sekmesi üzerine sağ klik yapıp kod görüntüle deyiniz. Kodu buraya uygulayacaksınız.

 

[latimera]

Sayfa sekmesi üzerine sağ klik yapıp kod görüntüle deyiniz. Kodu buraya uygulayacaksınız.

Yardımlarınız ve öğretiniz için teşekkür ederim.

 

[latimera]

Üsdatlar S.A


1- peki satırdakı yazıyı sildiğim zaman tarihi sildirmeyi nasıl yapabilir.
2- bütün sheet için bu makroyu nasıl aktif edebilirim.

 

[N.Ziya Hiçdurmaz]

yanıt

Kodu ThisWorkbook'un içine uygulayınız.

Private Sub Workbook_SheetChange(ByVal Sh As Object, ByVal Target As Range)
    If Intersect(Target, [b:b]) Is Nothing Then Exit Sub
        Target.Offset(0, -1) = Date
        If Target = "" Then
            Target.Offset(0, -1) = ""
        End If
End Sub

 

[latimera]

Kodu ThisWorkbook'un içine uygulayınız.

Private Sub Workbook_SheetChange(ByVal Sh As Object, ByVal Target As Range)
    If Intersect(Target, [b:b]) Is Nothing Then Exit Sub
        Target.Offset(0, -1) = Date
        If Target = "" Then
            Target.Offset(0, -1) = ""
        End If
End Sub

Sayın Ziya Bey,

Kodu excel yazdım ama aşağıdaki hatayı verdi ve excel sapıttı... ne yapabiliriz.

 

[N.Ziya Hiçdurmaz]

yanıt

Ekli dosyayı inceleyiniz.

 

[latimera]

Ekli dosyayı inceleyiniz.

Sayn Ziya bey,

ek'teki dosya yazmış olduğunuz makro nun uygulandığı dosya .

1- satırları yazdığımda tarih geç geliyor
2- açıklmayı sildiğimde aradan 2-5 sanayi geçtikten sonra tarihi siliyor.
3- seri işlem yaptığım zaman yukarıdaki hatayı tekrar veriyor.


Not: Sizin yapmış olduğunu makro nun benim dosyada uyguladığım son hali


If Intersect(Target, [c:c]) Is Nothing Then Exit Sub
Target.Offset(0, -2) = Date
If Target = "" Then
Target.Offset(0, -2) = ""
End If

 

[N.Ziya Hiçdurmaz]

yanıt

Bu şeklil deneyiniz.

Private Sub Workbook_SheetChange(ByVal Sh As Object, ByVal Target As Range)
On Error Resume Next
Application.ScreenUpdating = False
Application.Calculation = xlCalculationManual
If Intersect(Target, [c:c]) Is Nothing Then Exit Sub
Target.Offset(0, -2) = Date
If Target = "" Then
Target.Offset(0, -2) = ""
End If
Application.ScreenUpdating = True
Application.Calculation = xlCalculationAutomatic
End Sub

 

[latimera]

Bu şeklil deneyiniz.

Private Sub Workbook_SheetChange(ByVal Sh As Object, ByVal Target As Range)
On Error Resume Next
Application.ScreenUpdating = False
Application.Calculation = xlCalculationManual
If Intersect(Target, [c:c]) Is Nothing Then Exit Sub
Target.Offset(0, -2) = Date
If Target = "" Then
Target.Offset(0, -2) = ""
End If
Application.ScreenUpdating = True
Application.Calculation = xlCalculationAutomatic
End Sub

Sayın Ziya bey,

yapmış olduğunuz makroyu ekledim ama tepki vermedi... eksik yapmış olduğum işlem varmı ? Dosya ek'tedir.