Hücredeki tarihten 175 gün sonrasına uyarı

[tirEdsOuL]

8. satırdan başlayaıp aşağıda doğru devam eden binlerce satır mevcut.
D8 'de sipariş numarası,
K8 'de Açılış tarihi,
L8 'de Kapanış tarihi mevcut.

İsteğime gelecek olursak;
K8 dolu ve L8 boş ise, bugün K8'deki tarih + 175 gün ise, Ekrana "D8'deki sipariş numaralarının son alım günü K8+180 gündür" Msgbox ile uyarı vermesini istiyorum.

Tabiki bunu aşağıya doğru devam eden tüm satırlar için uygulamasını istiyorum.

İlginiz için şimdiden teşekkürler.

 

[msoauy]

Merhaba,

Kodu bi dener misin? Kodda açıklamaları yazdım umarım yararlı olur. Kodda sıkıntı olursa örnek dosya gönderirseniz daha iyi olur. Kolay gelsin...

Sub CheckRange()
    Dim WorkSheetName As String
    Dim rng As Range
    Dim Dtime As Date
    WorkSheetName = "" 'Değiştirilecek
    With ThisWorkbook.Worksheets(WorkSheetName)
    For Each rng In .Range("A8:A" & .Cells(Rows.Count, "A").End(xlUp).Row)
        'İlk satırda K değeri
        'İkinci satırda  L değeri
        'Üçüncü satırda K değeri ile bugün arasında 175 gün var mı diye kontrol
        If rng.Offset(0, OffSetNum("K")).Value <> "" And _
           rng.Offset(0, OffSetNum("L")) = "" And _
           DateDiff("d", rng.Offset(0, OffSetNum("K")).Value, Now) >= 175 Then
            
            MsgBox rng.Offset(0, OffSetNum("D")).Value & "'deki sipariş numaralarının son alım günü " & DateAdd("d", 175, rng.Offset(0, OffSetNum("K")).Value) & " gündür"
    Next rng
    End With
End Sub
Function OffSetNum(ByVal ColName As String) As Double 'OffSet değerini bulma
    OffSetNum = Range(ColName & "1").Column - 1
End Function

 

[tirEdsOuL]

İlginiz için çok teşekkürler, ama maalesef ben çalıştıramadım. Örnek ektedir.
Sarı ile işaretlediğim satırlar için ekranda Msgbox ile uyarı vermesini istiyorum.

Mantık aslında şu;
Kredili alış tarihinden itibaren 180 gün sonra benim o aracı kapatmam lazım, bunun için de 5 gün öncesinden uyarı vermesini istiyorum. Araç kapalıysa zaten L sütununda kapama tarihi yazıyor.

 

[tirEdsOuL]

Buradan indirebilirsiniz.

 

[msoauy]

Merhaba,

Kodu bi dener misin? Kodda açıklamaları yazdım umarım yararlı olur. Kodda sıkıntı olursa örnek dosya gönderirseniz daha iyi olur. Kolay gelsin...

Sub CheckRange()
    Dim WorkSheetName As String
    Dim rng As Range
    Dim Dtime As Date
    WorkSheetName = "" 'Değiştirilecek
    With ThisWorkbook.Worksheets(WorkSheetName)
    For Each rng In .Range("A8:A" & .Cells(Rows.Count, "A").End(xlUp).Row)
        'İlk satırda K değeri
        'İkinci satırda  L değeri
        'Üçüncü satırda K değeri ile bugün arasında 175 gün var mı diye kontrol
        If rng.Offset(0, OffSetNum("K")).Value <> "" And _
           rng.Offset(0, OffSetNum("L")) = "" And _
           DateDiff("d", rng.Offset(0, OffSetNum("K")).Value, Now) >= 175 Then
            
            MsgBox rng.Offset(0, OffSetNum("D")).Value & "'deki sipariş numaralarının son alım günü " & DateAdd("d", 175, rng.Offset(0, OffSetNum("K")).Value) & " gündür"
    Next rng
    End With
End Sub
Function OffSetNum(ByVal ColName As String) As Double 'OffSet değerini bulma
    OffSetNum = Range(ColName & "1").Column - 1
End Function

Sanırım End If unutmuşum tekrar dener misiniz

Sub CheckRange()
    Dim WorkSheetName As String
    Dim rng As Range
    Dim Dtime As Date
    WorkSheetName = "" 'Değiştirilecek
    With ThisWorkbook.Worksheets(WorkSheetName)
    For Each rng In .Range("A8:A" & .Cells(Rows.Count, "A").End(xlUp).Row)
        'İlk satırda K değeri
        'İkinci satırda  L değeri
        'Üçüncü satırda K değeri ile bugün arasında 175 gün var mı diye kontrol
        If rng.Offset(0, OffSetNum("K")).Value <> "" And _
           rng.Offset(0, OffSetNum("L")) = "" And _
           DateDiff("d", rng.Offset(0, OffSetNum("K")).Value, Now) >= 175 Then
            
            MsgBox rng.Offset(0, OffSetNum("D")).Value & "'deki sipariş numaralarının son alım günü " & DateAdd("d", 175, rng.Offset(0, OffSetNum("K")).Value) & " gündür"
        End If
    Next rng
    End With
End Sub
Function OffSetNum(ByVal ColName As String) As Double 'OffSet değerini bulma
    OffSetNum = Range(ColName & "1").Column - 1
End Function

 

[tirEdsOuL]

Sayfa koduna da ekledim, modül olarak da ekledim ama maalesef yine çalıştıramadım. Uyarı vermesi için ekstra birşey yapmam gerekmiyor sanırım değil mi?

 

[msoauy]

Sayfa koduna da ekledim, modül olarak da ekledim ama maalesef yine çalıştıramadım. Uyarı vermesi için ekstra birşey yapmam gerekmiyor sanırım değil mi?

Bende çalışıyor kod.

WorkSheetName = "" 'Değiştirilecek

Bu kısmı kendi worksheet ine göre düzenlemen gerekiyor. Hala hata geliyorsa hata ekran görüntüsünü paylaşır mısın?

 

[tirEdsOuL]

Bende çalışıyor kod.

WorkSheetName = "" 'Değiştirilecek

Bu kısmı kendi worksheet ine göre düzenlemen gerekiyor. Hala hata geliyorsa hata ekran görüntüsünü paylaşır mısın?

Dediğiniz alanı "Rapor" olarak değiştirmiştim zaten ama maalesef olmuyor, mümkün ise sizin çalışan dosyanızı yükleyebilir misiniz? Herhangi bir hata da vermiyor.

 

[tirEdsOuL]

Merhaba,
Makroyu kod penceresinden Run yapınca çalıştı, bende Autpen olarak ayarladım ve şuanda sorunsuz çalışıyor teşekkürler.
Çok elzem olmamakla birlikte şöyle birşey yapılabilir mi?
Her satır için ayrı ayrı uyarı vereceğine, hepsini tek bir msgbox ekranında verip, "Aşağıda detayları verilen araçların kapama tarihleri yaklaşmaktadır" yazıp, aşağıda da Sipariş No - Tarih bilgileri yer alabilir mi?