Tarih Gösterim Hatası

[tuvons]

Merhaba,

Aşağıdaki makro ile tarih bilgisi önceki ayın son günü ile bugün arasında olmayan hücreleri kırmızıya boyuyor fakat tarih biçimi 30.09.2021 olarak değil de 44469 olarak yazılan değerleri de doğru kabul ediyor. Tarih alanı dd.mm.yyyy olarak girilmemişse kırmızıya boyamayı nasıl ekleyebilirim?

Private Sub Makro20()
Set S1 = Worksheets("Sayfa1")
Set S2 = Worksheets("VERİLER")

    son = ActiveCell.SpecialCells(xlLastCell).Address
    sonsatir1001 = RakamAl(son)
    
    t1 = Format(DateSerial(Year(Now), Month(Now), 0), "dd.mm.yyyy")
    t2 = Format((Now), "dd.mm.yyyy")
    For Each ara1 In S1.Range("C2:C" & sonsatir1001)
    If Not ara1 >= t1 And Not ara1 <= t2 And Not ara1 = Format("dd.mm.yyyy") _
    Then ara1.Interior.Color = vbRed
    Next ara1
    
For x = 2 To sonsatir1001
If S1.Cells(x, 3).Interior.Color = vbRed Then
If S1.Cells(x, 3).Comment Is Nothing Then
S1.Cells(x, 3).AddComment
Else
S1.Cells(x, 3).Comment.Text Text:=S1.Cells(x, 3).Comment.Text & Chr(10) & "Tarih Hatalı!"
GoTo nn
End If
S1.Cells(x, 3).Comment.Text Text:="Tarih Hatalı!"
End If
nn:
Next x

End Sub

 

[Muzaffer Ali]

Merhaba.

Private Sub Makro20()
    Set S1 = Worksheets("Sayfa1")
    Set S2 = Worksheets("VERİLER")

    son = ActiveCell.SpecialCells(xlLastCell).Address
    sonsatir1001 = RakamAl(son)
    
    t1 = Format(DateSerial(Year(Now), Month(Now), 0), "dd.mm.yyyy")
    t2 = Format((Now), "dd.mm.yyyy")
    For Each ara1 In S1.Range("C2:C" & sonsatir1001)
        If Not ara1 >= t1 And Not ara1 <= t2 And Not ara1 = Format("dd.mm.yyyy") Then
            If IsDate(ara1) Then ara1.Interior.Color = vbRed
        End If
    Next ara1
    For x = 2 To sonsatir1001
        If S1.Cells(x, 3).Interior.Color = vbRed Then
            If S1.Cells(x, 3).Comment Is Nothing Then
                S1.Cells(x, 3).AddComment
            Else
                S1.Cells(x, 3).Comment.Text Text:=S1.Cells(x, 3).Comment.Text & Chr(10) & "Tarih Hatalı!"
                GoTo nn
            End If
            S1.Cells(x, 3).Comment.Text Text:="Tarih Hatalı!"
        End If
nn:
    Next x
End Sub

 

[tuvons]

Merhaba.

Private Sub Makro20()
    Set S1 = Worksheets("Sayfa1")
    Set S2 = Worksheets("VERİLER")

    son = ActiveCell.SpecialCells(xlLastCell).Address
    sonsatir1001 = RakamAl(son)
   
    t1 = Format(DateSerial(Year(Now), Month(Now), 0), "dd.mm.yyyy")
    t2 = Format((Now), "dd.mm.yyyy")
    For Each ara1 In S1.Range("C2:C" & sonsatir1001)
        If Not ara1 >= t1 And Not ara1 <= t2 And Not ara1 = Format("dd.mm.yyyy") Then
            If IsDate(ara1) Then ara1.Interior.Color = vbRed
        End If
    Next ara1
    For x = 2 To sonsatir1001
        If S1.Cells(x, 3).Interior.Color = vbRed Then
            If S1.Cells(x, 3).Comment Is Nothing Then
                S1.Cells(x, 3).AddComment
            Else
                S1.Cells(x, 3).Comment.Text Text:=S1.Cells(x, 3).Comment.Text & Chr(10) & "Tarih Hatalı!"
                GoTo nn
            End If
            S1.Cells(x, 3).Comment.Text Text:="Tarih Hatalı!"
        End If
nn:
    Next x
End Sub

@Muzaffer Ali teşekkürler yanıtınız için ama olmadı yine kırmızıya boyamadı. Başka bir yolu var mıdır?

 

[Muzaffer Ali]

Dosyanız eklerseniz kontrol edelim.