Excel - Mondphasen berechnen

[Flotter Feger]

Hallo,



einen Mondkalender gibt es hier https://www.schulferien.org/deutschland/mond/kalender/



und Function in Excel, die gibt es auch ...

Code:

Function MONDPHASE(Datum As Date) As String
Const SynodMonat As Double = 29.530588
Const SynodVollmond As Double = 105.6213922 'IstVollmondTag()
Const SynodHalbAb As Double = 113.0040392 'IstHalbmondTagAbnehmend()
Const SynodNeumond As Double = 120.3866862 'IstNeumondTag()
Const SynodHalbZu As Double = 127.7693332 'IstHalbmondTagZunehmend()

Dim DatumDbl As Double
Dim DatumLng As Long
Dim DatumVollMond As Date
Dim DatumNeuMond As Date
Dim DatumAbHalbMond As Date
Dim DatumZuHalbMond As Date
Dim i As Long

If Year(Datum) > 1900 And Year(Datum) < 2100 Then
    'Berechnung ob Vollmond oder nächster Vollmondtag
    For i = 1 To 2470
        DatumDbl = SynodVollmond + i * SynodMonat
        DatumLng = Int(DatumDbl)
        DatumVollMond = CDate(DatumLng)
        If DatumVollMond = Datum Then
            MONDPHASE = "Vollmond"
            Exit Function
        ElseIf DatumVollMond > Datum Then
            MONDPHASE = "zunehmend"
            DatumDbl = SynodHalbZu + (i - 1) * SynodMonat
            DatumLng = Int(DatumDbl)
            DatumZuHalbMond = DatumLng
            If DatumZuHalbMond = Datum Then
                MONDPHASE = "Halbmond zunehmend"
                Exit Function
            End If
            Exit For
        End If
   Next i
   'Berechnung ob Neumond oder nächster Neumondtag
   For i = 1 To 2470
        DatumDbl = SynodNeumond + i * SynodMonat
        DatumLng = Int(DatumDbl)
        DatumNeuMond = CDate(DatumLng)
        If DatumNeuMond = Datum Then
            MONDPHASE = "Neumond"
            Exit Function
        ElseIf DatumNeuMond > Datum And DatumNeuMond < DatumVollMond Then
            MONDPHASE = "abnehmend"
            DatumDbl = SynodHalbAb + i * SynodMonat
            DatumLng = Int(DatumDbl)
            DatumAbHalbMond = DatumLng
            If DatumAbHalbMond = Datum Then
                MONDPHASE = "Halbmond abnehmend"
                Exit Function
            End If
        End If
    Next i
End If
End Function