Doğum günü yaklaşanları listeleme

[peleryn]

Herkese Merhabalar;

Aşağıdaki kodlarla bu ay içerisinde doğum günü olanları listeliyorum.Ancak haliyle ayın ilerleyen günlerinde liste kısmen güncelliğini yitirmeye başlıyor.Misal ayın 1 inde doğum günü olan hala gözüküyor oluyor.
Nasıl bir değişiklikle bu kodu bugünden itibaren önümüzdeki 30 gün içinde doğum günü olanları listeleyecek hale getirebilirim?

Private Sub Label34_Click()
listeadı.Caption = "Bu Ay İçersinde Doğum Günü Olanlar"
Dim i As Long, a As Long
liste.ColumnCount = 2
liste.ColumnWidths = "100;100"
ReDim myarr(1 To 2, 1 To 1)
Sheets("GİRİŞ İŞLEMLERİ").Select
liste.Clear
For i = 2 To Cells(65536, "B").End(xlUp).Row
If Month(Cells(i, "M").Value) = Month(Date) Then
a = a + 1
ReDim Preserve myarr(1 To 2, 1 To a)
myarr(1, a) = Cells(i, "B").Value
myarr(2, a) = Format(Cells(i, "M").Value, "dd.mm.yyyy")
End If
Next i
If a > 0 Then
liste.Column = myarr
sayı.Text = Format(a, "#,##0") + " " + "Öğrenci"
End If
End Sub

İlgilenecek olan herkese şimdiden teşekkür ederim.

 

[leumruk]

Merhaba,
Deneme şansım olmadı; ama sorunu çözmesi lazım. Aşağıdaki satırı:

If Month(Cells(i, "M").Value) = Month(Date) Then

Bununla değiştirin:

If Month(Cells(i, "M").Value) = Month(Date) And Day(Cells(i, "M").Value) > Day(Date) Then

 

[Korhan Ayhan]

Selamlar,

Alternatif olarak For satırından sonra gelen If sorgunuzu aşağıdaki şekilde değiştirip denermisiniz.

[COLOR=black][FONT=Verdana]If Cells(i, "M").Value >= Date And Cells(i, "M").Value <= (Date+30) Then[/FONT][/COLOR]

 

[peleryn]

Korhan Hocam kodlarınızı denedim listboxta sonuç görüntülenmiyor.
Sayın Leumruk sizin kodlarınızda da bugünden bu ayın sonuna kadar olanları görüntülüyor.Bu durumda ayın 30 una geldiğimde ertesi gün ayın 1 inde doğum günü olan çocukları listeleyememiş olacağım.
Ama şu an ki haliyle en azından geçmiş doğum günleri listelenmemiş oluyor.
Yardımlarınızı bekliyorum.Teşekkür ederim.

 

[Korhan Ayhan]

Selamlar,

Dosyanızı eklemeniz mümkün mü?

 

[Necdet]

Merhaba,

Aşağıdaki kodları kendinize uyarlayınız.

Sub DogumGunu()
Dim Tarih As Date
Dim i As Long
Dim Liste As String
Liste = "1 AY İÇİNDEKİ DOĞUM GÜNÜ OLANLAR"
For i = 2 To [A65536].End(3).Row
    Tarih = DateSerial(Year(Date), Month(Cells(i, "B")), Day(Cells(i, "B")))
    If Tarih > Date And (Tarih - Date) < 31 Then
        Liste = Liste & Chr(10) & Cells(i, "A") & " ---> " & Cells(i, "B")
    End If
Next i
    MsgBox Liste
End Sub

 

[peleryn]

Örnek dosya ekliyorum..Dosyada "istatistikleri göster" butonu ile açılan userformda doğum günlerini sorgulamak üzere listbox ın altındaki ilgili label'a tıklayınız.

Necdet hocam verdiğiniz kodları birazdan uyarlamayı deneyeceğim.Teşekkür ediyorum.

 

[peleryn]

Necdet hocam kodlarınızı uyarladım tam istediğim gibi çalışıyor.Ellerinize sağlık.
Size ve ilgilenen diğer hocalarıma çok teşekkür ediyorum.