Girilen Tarih bir hücredeki tarihten eşit yada küçük olamaz

[htsumer]

Tahliye taahhütnamesinin tarihi, mutlaka kira sözleşmesinin yapıldığı tarihten sonra olması gerekir. Kanunda kira sözleşmesinden ne kadar süre sonra olacağı ile ilgili bir ibare bulunmasa da, bunun makul bir süre olması gerekiyor (15 gün ya da 1 ay sonra gibi).

Şimdi B20 Hücresinde Sözleşme Tarihi 01.01.2023 yazılı.
B24 de ise Tahliye Taahhüt Tarihi var.

Şimdi mutlaka kira sözleşmesinin yapıldığı tarihten sonra olması gerekir. Buna göre B24 girilen tarih B20 hücresini kontrol edip en az 15 gün sonra olması için bir kod lazım.
Yani B24 Hücresine en az 15/01/2023 yazılmalı. Bunu üsüt olabilir ama aşağısı olamaz ikazı vermeli..

 

[dEdE]

Merhaba,
Sayfanın kod bölümüne yapıştırarak dener misiniz?

Private Sub Worksheet_Change(ByVal Target As Range)
If Intersect(Target, [B24]) Is Nothing Then Exit Sub
If [B24] = "" Then Exit Sub
If DateDiff("d", [B20], [B24]) < 15 Then
    MsgBox "Kira sözleşmesinin yapıldığı tarihten en az 15 gün sonra olması gerekir", vbExclamation, "DİKKAT"
    [B24] = ""
    [B24].Select
End If
End Sub

 

[AdemCan]

Alternatif örnek.

Private Sub Worksheet_Change(ByVal Target As Range)
    If Target.Address = "$B$24" Then
        If Range("B24") = "" Then Exit Sub
        If IsDate(Range("B20")) And Range("B20") <> "" Then
            If IsDate(Range("B24")) Then
                If (Range("B24") < Range("B20")) Or ((Range("B24") - Range("B20")) + 1 <= 14) Then
                    MsgBox "Tahliye tarihi kira tarihinden küçük ya da 14 gün sonrası olamaz", , ""
                    Range("B24") = ""
                    Exit Sub
                End If
            Else
                MsgBox "Tahliye tarihini kontrol edin.", , ""
                Range("B24") = ""
                Exit Sub
            End If
        Else
            MsgBox "Kira tarihini kontrol edin.", , ""
            Range("B20") = ""
            Exit Sub
        End If
    End If
End Sub

 

[htsumer]

Merhaba,
Sayfanın kod bölümüne yapıştırarak dener misiniz?

Private Sub Worksheet_Change(ByVal Target As Range)
If Intersect(Target, [B24]) Is Nothing Then Exit Sub
If [B24] = "" Then Exit Sub
If DateDiff("d", [B20], [B24]) < 15 Then
    MsgBox "Kira sözleşmesinin yapıldığı tarihten en az 15 gün sonra olması gerekir", vbExclamation, "DİKKAT"
    [B24] = ""
    [B24].Select
End If
End Sub

Alternatif örnek.

Private Sub Worksheet_Change(ByVal Target As Range)
    If Target.Address = "$B$24" Then
        If Range("B24") = "" Then Exit Sub
        If IsDate(Range("B20")) And Range("B20") <> "" Then
            If IsDate(Range("B24")) Then
                If (Range("B24") < Range("B20")) Or ((Range("B24") - Range("B20")) + 1 <= 14) Then
                    MsgBox "Tahliye tarihi kira tarihinden küçük ya da 14 gün sonrası olamaz", , ""
                    Range("B24") = ""
                    Exit Sub
                End If
            Else
                MsgBox "Tahliye tarihini kontrol edin.", , ""
                Range("B24") = ""
                Exit Sub
            End If
        Else
            MsgBox "Kira tarihini kontrol edin.", , ""
            Range("B20") = ""
            Exit Sub
        End If
    End If
End Sub

Her iki kod şahane çalıştı çok teşekkür ederim ikinize de...