Otomatik Tarih ve Hücre Güncelleme

[1903emre34]

Excel Versiyonu

Excel 2019

Excel Sürümü

64 Bit

Excel Dili

Türkçe

Merhaba

A sütünda "003" olduğu takdirde, bulunduğu satır, sarı işaretli alana tarih yazdığım zaman (bir sonraki yıl) otomatik olarak yeşil boyanmış hücrelere 01-01-2023 yanına 31-12-2023 yazması için kodlarda değişiklik yapabilir miyiz

 

Yazdırma Alanı Değişikliği Yapma

[Ömer BARAN]

@1903emre34

Belgedeki kodun başlangıç kısmını şöyle değiştirerek deneyin.

Görüntülemek için giriş yapmanız gerekmektedir.
(10 satır)

 

[1903emre34]

Üstad, olmadı, kullandığım kod

 

[1903emre34]

Private Sub Worksheet_Change(ByVal Target As Range)
If Target.Column = 1 Or Target.Column = 4 Then
If Cells(Target.Row, 1).Text = "003" And IsDate(Cells(Target.Row, 4)) Then
Cells(Target.Row, 6) = DateSerial(Year(Cells(Target.Row, 4)) + 1, 1, 1)
Cells(Target.Row, 7) = DateSerial(Year(Cells(Target.Row, 4)) + 1, 12, 31)
End If
End If
If Target.Column <> 2 And Target.Column <> 4 Then Exit Sub
Application.EnableEvents = False
XD = Target.Value2: x = Target.Column
If Len(XD) = 7 And x = 4 Then XD = "0" & XD
If Len(XD) = 6 And x = 2 Then XD = "0" & XD
If x = 2 Then
If Len(XD) = 7 And IsNumeric(Mid(XD, 1, 2)) And _
IsNumeric(Mid(XD, 4, 4)) And InStr(XD, "/") = 0 And InStr(XD, "-") = 0 Then _
Target.Value = Mid(XD, 1, 2) & "-" & Mid(XD, 4, 4) & "/" & Mid(XD, 1, 2) & "-" & Mid(XD, 4, 4)
ElseIf x = 4 Then
If XD = "" Then
Target.Offset(0, 2) = "": Target.Offset(0, 3) = ""
ElseIf Len(XD) = 8 And (InStr(XD, "-") = 0 Or IsDate(XD)) Then
trh = Mid(XD, 1, 2) & "-" & Mid(XD, 3, 2) & "-" & Mid(XD, 5, 4)
Target.NumberFormat = "@": Target.Value = trh
Target.Offset(0, 2).Resize(1, 2).NumberFormat = "@"
Target.Offset(0, 2).Value = trh: Target.Offset(0, 3).Value = trh
End If
End If
Application.EnableEvents = True
End Sub

 

[1903emre34]

 

[Ömer BARAN]

Sıkıntıyı anladım sanırım.
Bir önceki önerimde belirttiğim değişikliği silip,
örnek belgede mevcut kodda yer alan Elseif.....Then satırından sonrasını şu hale getirin.

Görüntülemek için giriş yapmanız gerekmektedir.
(10 satır)

 

[1903emre34]

Hata verdi

 

[Ömer BARAN]

@1903emre34

Belge ekte.