Tarih kontrolu

[haso_excel]

Merhaba arkadaşlar,

Siteden bulduğum bir kodu kendime göre düzenlemeye çalıştım fakat bir koşulu daha eklemek istiyorum ama olmadı. G kolonundaki tarihleri kontrol ettirip E kolonundaki kişilerin isimlerini MSG kutusuna getiriyorum.
Koşullar +2 gün, 0, -1, -2, -3, gün e kadar
Soru : Eğer bunların dışında ise henüz bu iki gün içinde bir kişi bulunamadı mesajını nasıl verdiririm.

Sub dogum_günü()
Dim DTarih As Date
Dim i As Long
Set s1 = Sheets("liste")
Dim Mesaj As String
For i = 2 To s1.[g65536].End(3).Row
    DTarih = DateSerial(Year(Date), Month(s1.Cells(i, "g")), Day(s1.Cells(i, "g")))
    If DTarih - Date = 2 Then
        Mesaj = Mesaj & s1.Cells(i, "e") & Chr(13)
    ElseIf DTarih - Date = 0 Then
            Mesaj = Mesaj & s1.Cells(i, "e") & Chr(13)
    ElseIf DTarih - Date = -1 Then
            Mesaj = Mesaj & s1.Cells(i, "e") & Chr(13)
    ElseIf DTarih - Date = -2 Then
            Mesaj = Mesaj & s1.Cells(i, "e") & Chr(13)
    ElseIf DTarih - Date = -3 Then
    Mesaj = Mesaj & s1.Cells(i, "e") & Chr(13)
    
    End If
    
     Next i
 
    
MsgBox Mesaj, vbCritical, "2 GÜN SONRA DOĞUM GÜNÜ OLANLAR"
End Sub

 

[Ömer]

Merhaba,

Bu şekilde deneyin.

Sub dogum_günü()
Dim DTarih As Date
Dim i As Long
Set s1 = Sheets("liste")
Dim Mesaj As String
    For i = 2 To s1.[g65536].End(3).Row
        DTarih = DateSerial(Year(Date), Month(s1.Cells(i, "g")), _
        Day(s1.Cells(i, "g")))
            If DTarih - Date = 2 Then
                Mesaj = Mesaj & s1.Cells(i, "e") & Chr(13)
                ElseIf DTarih - Date = 0 Then
                    Mesaj = Mesaj & s1.Cells(i, "e") & Chr(13)
                ElseIf DTarih - Date = -1 Then
                    Mesaj = Mesaj & s1.Cells(i, "e") & Chr(13)
                ElseIf DTarih - Date = -2 Then
                    Mesaj = Mesaj & s1.Cells(i, "e") & Chr(13)
                ElseIf DTarih - Date = -3 Then
                    Mesaj = Mesaj & s1.Cells(i, "e") & Chr(13)
            End If
    Next i
            If Mesaj = "" Then
                Mesaj = "Henüz bu iki gün içinde bir kişi bulunamadı"
            End If
    MsgBox Mesaj, vbCritical, "2 GÜN SONRA DOĞUM GÜNÜ OLANLAR"
End Sub

.