DOSYA İndirmek/Yüklemek için ÜCRETLİ ALTIN ÜYELİK Gereklidir!
Altın Üyelik Hakkında Bilgi
Option Explicit
Sub TARİHLERİ_DÜZENLE()
Dim X As Long
For X = 2 To Range("A65536").End(3).Row
If Cells(X, 1) <> Date Then
If Day(Cells(X, 1)) = Day(Date) And Month(Cells(X, 1)) = Month(Date) Then
Cells(X, 1) = DateSerial(Year(Cells(X, 1)) + 1, Month(Cells(X, 1)), Day(Cells(X, 1)))
End If
End If
Next
MsgBox "İşleminiz tamamlanmıştır.", vbInformation
End Sub
Selamlar,
Aşağıdaki kodu kullanabilirsiniz.
Kod:Option Explicit Sub TARİHLERİ_DÜZENLE() Dim X As Long For X = 2 To Range("A65536").End(3).Row If Cells(X, 1) <> Date Then If Day(Cells(X, 1)) = Day(Date) And Month(Cells(X, 1)) = Month(Date) Then Cells(X, 1) = DateSerial(Year(Cells(X, 1)) + 1, Month(Cells(X, 1)), Day(Cells(X, 1))) End If End If Next MsgBox "İşleminiz tamamlanmıştır.", vbInformation End Sub
Selamlar,
Aşağıdaki kodu kullanabilirsiniz.
Kod:Option Explicit Sub TARİHLERİ_DÜZENLE() Dim X As Long For X = 2 To Range("A65536").End(3).Row [COLOR="Red"]If Cells(X, 1) = Date Then[/COLOR] If Day(Cells(X, 1)) = Day(Date) And Month(Cells(X, 1)) = Month(Date) Then Cells(X, 1) = DateSerial(Year(Cells(X, 1)) + 1, Month(Cells(X, 1)), Day(Cells(X, 1))) End If End If Next MsgBox "İşleminiz tamamlanmıştır.", vbInformation End Sub
Option Explicit
Sub AUTO_OPEN()
Dim X As Long
Sheets("Sayfa1").Select
For X = 2 To Range("A65536").End(3).Row
If Cells(X, 1) <> Date Then
If Day(Cells(X, 1)) = Day(Date) And Month(Cells(X, 1)) = Month(Date) Then
Cells(X, 1) = DateSerial(Year(Cells(X, 1)) + 1, Month(Cells(X, 1)), Day(Cells(X, 1)))
End If
End If
Next
MsgBox "İşleminiz tamamlanmıştır.", vbInformation
End Sub