Yaklaşan tarihleri bildirme

[işsiz123]

Merhabalar
A:A sütunda olan son kullanma tarihleri 30 gün ve altında olanlari msgbox ile uyarı vesin.


Böyle bir kod buldum fakat gününde uyarı veriyor.

Sub denetle()
    tarih = Format(Now, "dd.mm.yyyy")
    For i = 1 To Sheets("Sayfa1").Range("a65536").End(3).Row
        If tarih = Format(Cells(i, 1), "dd.mm.yyyy") Then
            say = say + 1
            mesaj = "Dikkat : " & vbCr
            msj = msj & Cells(i, 2) & vbCr
        End If
    Next i
    If say >= 1 Then
        MsgBox "Dikkat az günü olan " & say & " kişi var" & vbCr & mesaj & vbCr & msj
    End If
End Sub

 

[Muzaffer Ali]

Merhaba.
Aşağıdaki kodu kullanın.

Sub denetle()
    Dim i As Long, say As Long, mesaj As String
    For i = 1 To Sheets("Sayfa1").Range("A" & Rows.Count).End(3).Row
        If DateAdd("d", 30, Cells(i, 1)) >= Now Then
            say = say + 1
        End If
    Next i
    If say >= 1 Then
        MsgBox "Dikkat son ullanma tarihi 30 gün ve daha az olan " & say & " ürün var.", vbCritical
    End If
End Sub

 

[işsiz123]

Teşekkürler

 

[ASLAN7410]

Sayın dalgalikur ellerinize sağlık, kod gayet güzel çalışıyor.
Küçük bir sorun var galiba, aynı gün, 30 gün ve küçük olanlar 5 olması gerekirken 8 çıkıyor.
Ayrıca sayfada 1.satıra başlık eklediğimde kod hata veriyor.

Bu konuda yardımcı olur musunuz?

 

[Muzaffer Ali]

Sayın dalgalikur ellerinize sağlık, kod gayet güzel çalışıyor.
Küçük bir sorun var galiba, aynı gün, 30 gün ve küçük olanlar 5 olması gerekirken 8 çıkıyor.
Ayrıca sayfada 1.satıra başlık eklediğimde kod hata veriyor.

Bu konuda yardımcı olur musunuz?

Sayın ASLAN7410 kodu düzenlerdim. hata varmış.

Private Sub Workbook_Open()
    Dim i As Long, say As Long, mesaj As String, Fark As Long
    For i = 2 To Sheets("Sayfa1").Range("A" & Rows.Count).End(3).Row
        If IsDate(Cells(i, 1)) Then
        Fark = Cells(i, 1) - Date
            If Fark > -1 And Fark < 31 Then
                say = say + 1
                Cells(i, 2) = 1
            End If
        End If
    Next i
    If say >= 1 Then
        MsgBox "Dikkat son kullanma tarihi 30 gün ve daha az olan " & say & " ürün var.", vbInformation
    End If
End Sub

 

[ASLAN7410]

Sayın dalgalikur ellerinize sağlık, şimdi süper oldu.

Hayırlı günler diliyorum.

 

[çıtır]

Bende hazırlamıştım.Alternatif olsun.

Sub auto_Open()
Dim son As Long: Dim s1 As Worksheet
Set s1 = Sheets("Sayfa1")
son = Sheets("Sayfa1").Range("A65536").End(3).Row
mesaj = "Dikkat 30 ve az günü olan : " & vbCr
krt = Date + 30
msj = WorksheetFunction.CountIfs(s1.Range("A2:A" & son), "<=" & CDbl(CDate(krt)), s1.Range("A2:A" & son), "<=" & CDbl(CDate(Date)))
MsgBox mesaj & vbCr & msj & " kişi var"
End Sub

 

[ASLAN7410]

Sayın çıtır sizinde ellerinize sağlık, bu da güzel bir çalışma olmuş.

Hayırlı günler diliyorum.

 

[çıtır]

Sayın çıtır sizinde ellerinize sağlık, bu da güzel bir çalışma olmuş.

Hayırlı günler diliyorum.

Rica ederim.Dönüş yaptığınız için teşekkür ederim.