Otomatik Tarih ve Hücre Güncelleme

Durum
Üzgünüz bu konu cevaplar için kapatılmıştır...

Kısa Açıklama

Otomatik Tarih ve Hücre Güncelleme isimli başlıkta, ilgili işlemlere dair detaylar yer almaktadır.
Excel Versiyonu
Excel 2019
Excel Sürümü
64 Bit
Excel Dili
Türkçe

Ekli dosyalar

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
 
1731881536479.webp
 
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.

Kod:
Görüntülemek için giriş yapmanız gerekmektedir.
(10 satır)
 
Durum
Üzgünüz bu konu cevaplar için kapatılmıştır...
Benzer Konular Popüler İçerikler Daha Fazlası
Geri
Üst