Excel VBA - Geburtstage

Der folgende Code überprüft eine Tabelle, damit man sieht wer in den nächsten 14 Tagen Geburtstag hat.

 

 
  A B C
1 Name Vorname Geburtstag
2 Name1 Vorname1 27.09.2003
3 Name2 Vorname2 28.09.2003
4 Name3 Vorname3 29.09.2003
5 Name4 Vorname4 30.09.2003
6 Name5 Vorname5 01.10.2003
7 Name6 Vorname6 02.10.2003
8 Name7 Vorname7 03.10.2003
9 Name8 Vorname8 04.10.2003
10 Name9 Vorname9 05.10.2003
 





Der Code:

 

Option Explicit

Sub Geburtstag()
Dim intgeb As Integer
Dim Loletzte As Long
Dim MsgText As String
Dim intalter As Integer
    Loletzte = IIf(IsEmpty(Range("c65536")), Range("c65536").End(xlUp).Row, 65536)
    For intgeb = 2 To Loletzte
        intalter = (DateSerial(Year(Date), Month(Date), Day(Date)) - DateSerial(Year(Cells(intgeb, 3)), Month(Cells(intgeb, 3)), _
        Day(Cells(intgeb, 3)))) / 365.25
        If DateSerial(Year(Date), Month(Cells(intgeb, 3)), Day(Cells(intgeb, 3))) >= DateSerial(Year(Date), Month(Date), _
            Day(Date)) And DateSerial(Year(Date), Month(Cells(intgeb, 3)), Day(Cells(intgeb, 3))) <= DateSerial(Year(Date), _
            Month(Date), Day(Date) + 14) Or DateSerial(Year(Date) + 1, Month(Cells(intgeb, 3)), Day(Cells(intgeb, 3))) _
            <= DateSerial(Year(Date), Month(Date), Day(Date) + 14) Then
            MsgText = MsgText & vbLf & vbLf & Cells(intgeb, 3 - 2) & ",   " & Cells(intgeb, 3 - 1) & "  " & Cells(intgeb, 3) _
            & "  " & "wird " & intalter & " Jahre alt"
        End If
    Next intgeb
    If Len(MsgText) > 0 Then MsgBox Right(MsgText, Len(MsgText) - 2)
End Sub
Cookies erleichtern die Bereitstellung unserer Dienste. Mit der Nutzung unserer Dienste erklären Sie sich damit einverstanden, dass wir Cookies verwenden.
Weitere Informationen Ok