Çözüldü 2 Tarih Arası Gün Hesaplama ve Uyarı Verme

[karakrall01]

Herkese kolay gelsin,
Çalışma sayfamın (“A”) kolonunda çeşitli tarihler yer almakta ve (“B”) kolunda bu tarihlerin bana hatırlatılmasını istediğim tarihleri yazmaktayım. (“A”) kolonunda ki tarihlerin (“B”) kolonunda ki karşılığına gelen tarihlere 10 gün kala bana userformumun uyarı vermesini istiyorum(…… çalışmanızın 10 günlük süresi kalmıştır. Şeklinde)

Bu konuda yardımcı olursanız memnun kalırım saygılarımla.

 

[RBozkurt]

Örnek dosya paylaşma imkanınız varmı?
Eksiklik var; mesela C sütununda proje adı vs mi var? .... çalışmasından kasıt nedir.
Bu sütunda 10 günü kalan iş tekil mi, çoğul mu mesela?

 

[RBozkurt]

Sub SureUyari()
    Dim sonSatir As Long
    Dim i As Long
    Dim hatirlatmaTarihi As Date
    Dim uyariMesaji As String
    
    sonSatir = Range("A" & Rows.Count).End(xlUp).Row
    
    For i = 1 To sonSatir
        If IsDate(Range("A" & i).Value) And IsDate(Range("B" & i).Value) Then
            hatirlatmaTarihi = Range("B" & i).Value - 10
            If hatirlatmaTarihi <= Range("A" & i).Value And Range("A" & i).Value <= Range("B" & i).Value Then
                uyariMesaji = uyariMesaji & vbNewLine & Format(Range("A" & i).Value, "dd.mm.yyyy")
            End If
        End If
    Next i
    
    If uyariMesaji <> "" Then
        uyariMesaji = "Aşağıdaki çalışmalarınızın 10 günlük süresi kalmıştır:" & vbNewLine & uyariMesaji
        MsgBox uyariMesaji
    End If
End Sub

 

[karakrall01]

Sub SureUyari()
    Dim sonSatir As Long
    Dim i As Long
    Dim hatirlatmaTarihi As Date
    Dim uyariMesaji As String
   
    sonSatir = Range("A" & Rows.Count).End(xlUp).Row
   
    For i = 1 To sonSatir
        If IsDate(Range("A" & i).Value) And IsDate(Range("B" & i).Value) Then
            hatirlatmaTarihi = Range("B" & i).Value - 10
            If hatirlatmaTarihi <= Range("A" & i).Value And Range("A" & i).Value <= Range("B" & i).Value Then
                uyariMesaji = uyariMesaji & vbNewLine & Format(Range("A" & i).Value, "dd.mm.yyyy")
            End If
        End If
    Next i
   
    If uyariMesaji <> "" Then
        uyariMesaji = "Aşağıdaki çalışmalarınızın 10 günlük süresi kalmıştır:" & vbNewLine & uyariMesaji
        MsgBox uyariMesaji
    End If
End Sub

hocam tamda istediğim buydu teşekkür ederim

 

[RBozkurt]

Rica ederim kolay gelsin.

 

[karakrall01]

Rica ederim kolay gelsin.

hatirlatmaTarihi = Range("B" & i).Value - 10

hocam birşey sorucam sadece burda istediğim gun sayisini textbox araciliği ile verebilirmiyiz? textbox koymaya çalistim ama basarili olamadim malesef

 

[RBozkurt]

Nasıl yani anlayamadım

 

[karakrall01]

Nasıl yani anlayamadım

Hocam

hatirlatmaTarihi = Range("B" & i).Value - 10

bu kod blogunda bulunan "10" sayısını manuel olarak kod içerisinden değiştirmek yerine burasını textbox aracılığıyla istediğimiz sayıyı belirtebilirmiyiz

 

[RBozkurt]

Sub TarihUyari()
    Dim sonSatir As Long
    Dim i As Long
    Dim hatirlatmaTarihi As Date
    Dim uyariMesaji As String
    Dim gunSayisi As Integer
    Dim uyariVar As Boolean
    
    gunSayisi = InputBox("Lütfen kaç gün kala uyarı verilmesini istediğinizi girin:")
    
    If gunSayisi < 1 Then
        MsgBox "Lütfen 1'den büyük bir sayı girin."
        Exit Sub
    End If
    
    sonSatir = Range("A" & Rows.Count).End(xlUp).Row
    
    For i = 1 To sonSatir
        If IsDate(Range("A" & i).Value) And IsDate(Range("B" & i).Value) Then
            hatirlatmaTarihi = Range("B" & i).Value - gunSayisi
            If hatirlatmaTarihi <= Range("A" & i).Value And Range("A" & i).Value <= Range("B" & i).Value Then
                uyariMesaji = uyariMesaji & vbNewLine & Format(Range("A" & i).Value, "dd.mm.yyyy")
                uyariVar = True
            End If
        End If
    Next i
    
    If uyariVar Then
        uyariMesaji = "Aşağıdaki çalışmalarınızın " & gunSayisi & " günlük süresi kalmıştır:" & vbNewLine & uyariMesaji
        MsgBox uyariMesaji
    Else
        MsgBox "Seçtiğiniz süreye uygun bir hatırlatma tarihi yok."
    End If
End Sub

 

[karakrall01]

Sub TarihUyari()
    Dim sonSatir As Long
    Dim i As Long
    Dim hatirlatmaTarihi As Date
    Dim uyariMesaji As String
    Dim gunSayisi As Integer
    Dim uyariVar As Boolean
   
    gunSayisi = InputBox("Lütfen kaç gün kala uyarı verilmesini istediğinizi girin:")
   
    If gunSayisi < 1 Then
        MsgBox "Lütfen 1'den büyük bir sayı girin."
        Exit Sub
    End If
   
    sonSatir = Range("A" & Rows.Count).End(xlUp).Row
   
    For i = 1 To sonSatir
        If IsDate(Range("A" & i).Value) And IsDate(Range("B" & i).Value) Then
            hatirlatmaTarihi = Range("B" & i).Value - gunSayisi
            If hatirlatmaTarihi <= Range("A" & i).Value And Range("A" & i).Value <= Range("B" & i).Value Then
                uyariMesaji = uyariMesaji & vbNewLine & Format(Range("A" & i).Value, "dd.mm.yyyy")
                uyariVar = True
            End If
        End If
    Next i
   
    If uyariVar Then
        uyariMesaji = "Aşağıdaki çalışmalarınızın " & gunSayisi & " günlük süresi kalmıştır:" & vbNewLine & uyariMesaji
        MsgBox uyariMesaji
    Else
        MsgBox "Seçtiğiniz süreye uygun bir hatırlatma tarihi yok."
    End If
End Sub

Teşekkür ederim hocam elinize sağlık

 

[RBozkurt]

Önemli değil kolay gelsin.

 

[RBozkurt]

Sub TarihHatirlatici()
    Dim sonSatir As Long
    Dim i As Long
    Dim tarih As Date
    Dim hatirlatmaTarihi As Date
    Dim gunFarki As Integer
    Dim hatirlatmalar As String
    
    sonSatir = Cells(Rows.Count, 1).End(xlUp).Row
    
    For i = 2 To sonSatir
        tarih = Cells(i, 1).Value
        hatirlatmaTarihi = Cells(i, 2).Value
        gunFarki = DateDiff("d", tarih, hatirlatmaTarihi)
        
        If gunFarki <= 10 And gunFarki >= 0 Then
            hatirlatmalar = hatirlatmalar & gunFarki & " gün içinde süre doluyor!    : " & Cells(i, 1) & vbNewLine
        End If
    Next i
    
    If hatirlatmalar <> "" Then
        MsgBox hatirlatmalar
    End If
End Sub

 

[karakrall01]

Sub TarihHatirlatici()
    Dim sonSatir As Long
    Dim i As Long
    Dim tarih As Date
    Dim hatirlatmaTarihi As Date
    Dim gunFarki As Integer
    Dim hatirlatmalar As String
   
    sonSatir = Cells(Rows.Count, 1).End(xlUp).Row
   
    For i = 2 To sonSatir
        tarih = Cells(i, 1).Value
        hatirlatmaTarihi = Cells(i, 2).Value
        gunFarki = DateDiff("d", tarih, hatirlatmaTarihi)
       
        If gunFarki <= 10 And gunFarki >= 0 Then
            hatirlatmalar = hatirlatmalar & gunFarki & " gün içinde süre doluyor!    : " & Cells(i, 1) & vbNewLine
        End If
    Next i
   
    If hatirlatmalar <> "" Then
        MsgBox hatirlatmalar
    End If
End Sub

Hocam bu kod çok güzel çalışıyor fakat bir sorum olucaktı tekrardan örnek vererek açıklamak gerekirse;
15.04.2023 tarihinde kayıtımı yaptım ve bu tarihten tam 1 yıl sonra yani 15.04.2024 yılına 45 gün kaldığında uyarı vermesini nasıl sağlayabilirim? Sizin vermiş olduğunuz kod aynı yıl içerisinde bulunan tarihler arasında istediğim kadar gün kaldığında uyarı veriyor fakat yuksrda vermiş olduğum örneğe göre uyarı vermiyoe malesef şimdiden teşekkürler cevabınız için

 

[tahsinanarat]

Sn. @RBozkurt kalan gün sayılarını mesaj kutusunda değilde d sutununa yazdırmak istersek, kodda nasıl bir değişiklik yapmalıyız. Teşekkürler.

 

[karakrall01]

Hocam bu kod çok güzel çalışıyor fakat bir sorum olucaktı tekrardan örnek vererek açıklamak gerekirse;
15.04.2023 tarihinde kayıtımı yaptım ve bu tarihten tam 1 yıl sonra yani 15.04.2024 yılına 45 gün kaldığında uyarı vermesini nasıl sağlayabilirim? Sizin vermiş olduğunuz kod aynı yıl içerisinde bulunan tarihler arasında istediğim kadar gün kaldığında uyarı veriyor fakat yuksrda vermiş olduğum örneğe göre uyarı vermiyoe malesef şimdiden teşekkürler cevabınız için

Sorum güncel

 

[RBozkurt]

If gunFarki <= 10
Satırını
If gunFarki <= 45

Yaparsanız referans tarihten 45 gün önce uyarı verir.

 

[karakrall01]

Hp

If gunFarki <= 10
Satırını
If gunFarki <= 45

Yaparsanız referans tarihten 45 gün önce uyarı verir.

Hocam o şekilde veriyor sıkıntı yok ama verdiğim örnekte ki gibi “01.01.2023 yılının 01.01.2024 yılına” 45 gün kaldığında vermiyor malesef araya yıl değişikliği girdiğinde neden vermiyor anlayamadım

 

[RBozkurt]

Tarihimiz 1 ocak 2023,
1 sene sonrası 1 ocak 2024

Uyarıyı hangi tarihte vermesi lazım onu anlayamadım. Siz uyarı verecek tarihi belirtin bi

 

[karakrall01]

Tarihimiz 1 ocak 2023,
1 sene sonrası 1 ocak 2024

Uyarıyı hangi tarihte vermesi lazım onu anlayamadım. Siz uyarı verecek tarihi belirtin bi

01 Ocak 2024 hocam

 

[RBozkurt]

1 ocak 2024 tarihine 45 gün kala mı uyarı vermesi lazım. 45 günün fonksiyonu nedir