Soru Doğum günü makrosunu geliştirme..

[policeman]

Merhaba..
Daha önce excel.web.tr sayfalarından bulduğum "bugün doğum günleri olanlar" makrosunu kendi örneğime zorda olsa uyarlıyabildim..
Yardımcı olursanız üç değişiklik daha yapmak istiyorum;
1."Data" sayfası S sütununda bulunan "YAŞAM" başlığındaki şartlardan sonuç "SAĞ" ise makro çalıştığında istenen sonucu getirsin, "VEFAT" ise sonuç getirmesin. Yani "SAĞ" olanların doğum günlerini getirmek istiyorum.
2."Data" sayfası N sütununda bulunan "DOĞUM GÜNÜ" başlığı makro çalıştığı zaman "Günler" sayfasında C2 hücresine gelsin.
3.Düğmeye bastığımızda sonuçlar gelince; "İŞLEM TAMAMLANMIŞTIR" ama gelecek sonuç yok ise "BUGÜN DOĞUM GÜNÜ OLAN YOKTUR" mesajı çıksın...
Saygılarımla...

 

[AdemCan]

Merhaba
For i = 3 To sp.Cells(Rows.Count, "F").End(3).Row satırı ile başlayan bölümü şu şekilde değiştiriniz.

For i = 3 To sp.Cells(Rows.Count, "F").End(3).Row
        If sp.Cells(i, "S").Value = "SAĞ" Then
            If Format(sp.Cells(i, "N"), "mmdd") = Tar Then
                j = j + 1
                Cells(j, "A") = j - 4
                Cells(j, "B") = sp.Cells(i, "A")
                Cells(j, "C") = sp.Cells(i, "F")
                Cells(j, "D") = sp.Cells(i, "G")
                Cells(j, "E") = sp.Cells(i, "H")
                Cells(j, "F") = sp.Cells(i, "N")
            End If
        End If
    Next i
    
sbs = sb.Cells(Rows.Count, "A").End(3).Row
If sbs < 5 Then
sb.Range("C2").Value = ""
    MsgBox "Bugün Doğum Günü Olan Yok.", vbInformation, "Bilgi"
Else
sb.Range("C2").Value = sp.Range("N1").Value
    MsgBox "İşlem tamamlandı.", vbInformation, "Bilgi"
End If

 

[policeman]

Sayın faye_efsane; bilginize emeğinize sağlık, çok teşekkür ederim..
Konu çözülmüştür..

 

[AdemCan]

Rica ederim, iyi çalışmalar.

 

[YUSUF44]

Alternatif olsun:

Sub OnemliGunler()
    Dim i, eski, yeni, son As Integer
    Dim s1, s2  As Worksheet
    Dim Tar As String
    Set s1 = Sheets("Data")
    Set s2 = Sheets("Günler")
    s2.Activate
    son = s1.Cells(Rows.Count, "A").End(3).Row
    eski = s2.Cells(Rows.Count, "A").End(3).Row
    If eski > 4 Then
        s2.Range("A5:F" & eski).ClearContents
    End If
    If IsDate(s2.[F1]) Then
        Tar = Format(s2.[F1], "mmdd")
    Else
        MsgBox "Lütfen F1 hücresine tarih giriniz!", vbExclamation
        [F1].Select
        Exit Sub
    End If
    Application.ScreenUpdating = False
        For i = 3 To son
            If Format(s1.Cells(i, "N"), "mmdd") = Tar And s1.Cells(i, "S") = "SAĞ" Then
                yeni = WorksheetFunction.Max(5, s2.Cells(Rows.Count, "A").End(3).Row + 1)
                s2.Cells(yeni, "A") = yeni - 4
                s2.Cells(yeni, "B") = s1.Cells(i, "A")
                s2.Cells(yeni, "C") = s1.Cells(i, "F")
                s2.Cells(yeni, "D") = s1.Cells(i, "G")
                s2.Cells(yeni, "E") = s1.Cells(i, "H")
                s2.Cells(yeni, "F") = s1.Cells(i, "N")
            End If
        Next
        s2.[C2] = [N1]
    Application.ScreenUpdating = True
    If s2.[A5] <> "" Then
        MsgBox "İŞLEM TAMAMLANMIŞTIR", vbExclamation
    Else
        MsgBox "BUGÜN DOĞUM GÜNÜ OLAN YOKTUR", vbExclamation
    End If
End Sub

 

[policeman]

Sayın YUSUF44; bilginize emeğinize sağlık, çok teşekkür ederim..
F1 hücresini unutmamak için denetlemek hoş olmuş ama 2 numaralı değişiklik çalışmadı; bilginiz olsun..
Saygılarımla..

 

[YUSUF44]

Küçük bir eksiklik var, ilgili kısmı aşağıdaki şekilde düzeltin lütfen:

s2.[C2] = s1.[N1]

 

[policeman]

Sayın YUSUF44; bilginize emeğinize sağlık, bu sefer tamamdır.. Tekrar teşekkür ederim..

 

[policeman]

sbs = sb.Cells(Rows.Count, "A").End(3).Row
If sbs < 5 Then
sb.Range("C2").Value = ""

Makronun bu kısmındaki 5 rakamı neyi ifade ediyor?

 

[relaxim]

Merhaba,

Günler sayfasındaki 5. satırı yani ilk kaydı.

 

[policeman]

Sayın relaxim teşekkürler..

 

[istanbulcahan]

Küçük bir eksiklik var, ilgili kısmı aşağıdaki şekilde düzeltin lütfen:

s2.[C2] = s1.[N1]

İyi geceler. Üstadım. sizin makroyu uyguladım. Ekleme olarak s2.[C2] = s1.[N1] yazmışsınız. Compile error Syntax error veriyor. Nasıl düzelebilir.

 

[YUSUF44]

İyi geceler. Üstadım. sizin makroyu uyguladım. Ekleme olarak s2.[C2] = s1.[N1] yazmışsınız. Compile error Syntax error veriyor. Nasıl düzelebilir.

Merhaba.

Bu çözüm mevcut soru ve dosyada doğru sonuca ulaşmak için verdiğim ve sorunu çözen bir çözümdü. Sizde çözmüyorsa dosya yapısı farklı olabilir ya da bir şeyleri yanlış yapmışsınızdır.