Tarihe Göre Kıdem Teşvik Filtreleme

[direnvip]

Merhabalar,
Göndermiş olduğum dosyada "D2" kolonunu yazılan tarihteki ay baz alınarak o ay içerisinde şirkete giriş tarihine göre 5 10 15 20 ve 25 yılını doldurmuş personelleri göstermesini istiyorum. Örnek vermek gerekirse d2 ye yazıdıgım tarih 01.01.2021 oldugunda tam ocak ayında 5 10 15 20 ve 25 yılını doldurmuş personelleri listelemesini istiyorum. Bir önceki ay dolduranları(01.12.2020) Aralık ayında veya daha önce dolduranlar bu listeye dahil etmesin. O ay hangi personel dolduruyorsa onları görmek istiyorum. Bunları yapabilmem için yol gösteririseniz çok mutlu olurum. Şimdiden Teşekkür ederim herkese

 

[ÖmerFaruk]

Butonunuza bu kodu atayın. İlgili hücre aralığını renklendirdim.

Sub First()
    If Worksheets("Sayfa1").Range("D2").Value = "" Then MsgBox ("Lütfen tarih giriniz..")
    Range("A2:B" & Range("A2").End(xlDown).Row).Interior.Color = xlNone
    For i = 2 To Range("A2").End(xlDown).Row
        If (DateDiff("m", Range("D2"), Range("B" & i)) Mod 12) = 0 Then
            Range("A" & i, "B" & i).Interior.Color = vbYellow
        End If
    Next i
End Sub

 

[direnvip]

Butonunuza bu kodu atayın. İlgili hücre aralığını renklendirdim.

Sub First()
    If Worksheets("Sayfa1").Range("D2").Value = "" Then MsgBox ("Lütfen tarih giriniz..")
    Range("A2:B" & Range("A2").End(xlDown).Row).Interior.Color = xlNone
    For i = 2 To Range("A2").End(xlDown).Row
        If (DateDiff("m", Range("D2"), Range("B" & i)) Mod 12) = 0 Then
            Range("A" & i, "B" & i).Interior.Color = vbYellow
        End If
    Next i
End Sub

Çok teşekkür ederim tam istediğim gibi emeğinize sağlık . Çok yeniyim makro işinde önerebileceginiz bir egitim seti veya bir herhangi bir yer var mı ?

 

[ÖmerFaruk]

Kitap reklama girer. Bu forumda bile yazar arkadaşlar var.
Forumları takip etmenizi şiddetle öneririm.
Pratik şart.
Bazı forumlara bu linkten erişebilirsin.

 

[direnvip]

Butonunuza bu kodu atayın. İlgili hücre aralığını renklendirdim.

Sub First()
    If Worksheets("Sayfa1").Range("D2").Value = "" Then MsgBox ("Lütfen tarih giriniz..")
    Range("A2:B" & Range("A2").End(xlDown).Row).Interior.Color = xlNone
    For i = 2 To Range("A2").End(xlDown).Row
        If (DateDiff("m", Range("D2"), Range("B" & i)) Mod 12) = 0 Then
            Range("A" & i, "B" & i).Interior.Color = vbYellow
        End If
    Next i
End Sub

Bu arada çalıştırdıgımda o ay 7. senesini dolduran personelide gösteriyor. ben ise özellikle sadece 5 10 15 20 ve 25 inci yıllarını o ay dolduran personeli görmek istiyorum.

 

[ÖmerFaruk]

Pardon, soruyu tam okumamamışım.
Mod 12 yazan kısmı Mod 60 yapın.

 

[direnvip]

Pardon, soruyu tam okumamamışım.
Mod 12 yazan kısmı Mod 60 yapın.

Çok teşekkür ederim. İyi akşamlar diliyorum.

 

[veyselemre]

Sub First()
    If Worksheets("Sayfa1").Range("D2").Value = "" Then MsgBox ("Lütfen tarih giriniz..")
    ay = Month([d2])
    yil = Year([d2])
    [e:f].ClearContents
    For i = 2 To Cells(Rows.Count, 1).End(3).Row
        If Month(Cells(i, 2).Value) = ay And (yil - Year(Cells(i, 2).Value)) Mod 5 = 0 Then
            Cells(i, 5).Value = yil - Year(Cells(i, 2).Value)
            Cells(i, 6).Value = DateSerial(yil, ay, Day(Cells(i, 2).Value) + 1)
        End If
    Next i
End Sub

 

[direnvip]

Sub First()
    If Worksheets("Sayfa1").Range("D2").Value = "" Then MsgBox ("Lütfen tarih giriniz..")
    ay = Month([d2])
    yil = Year([d2])
    [e:f].ClearContents
    For i = 2 To Cells(Rows.Count, 1).End(3).Row
        If Month(Cells(i, 2).Value) = ay And (yil - Year(Cells(i, 2).Value)) Mod 5 = 0 Then
            Cells(i, 5).Value = yil - Year(Cells(i, 2).Value)
            Cells(i, 6).Value = DateSerial(yil, ay, Day(Cells(i, 2).Value) + 1)
        End If
    Next i
End Sub

Çok teşekkürler iyi akşamlar.