Excel - Mondphasen berechnen

[Flotter Feger]

Hallo,

natürlich ist das mit der Function nur eine grobe Näherung ... schließlich sind die Stunden nicht exakt mit einbezogen, sondern nur die Tage.

Habe deshalb den Code ein weinig überarbeitet und konnte durch das Runden eine geringfügige Erhöhung der Genauigkeit erzielen.

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(WorksheetFunction.Round(DatumDbl, 0))
        If DatumVollMond = Datum Then
            MONDPHASE = "Vollmond"
            Exit Function
        ElseIf DatumVollMond > Datum Then
            MONDPHASE = "zunehmend"
            DatumDbl = SynodHalbZu + (i - 1) * SynodMonat
            'DatumLng = Int(DatumDbl)
            DatumZuHalbMond = CDate(WorksheetFunction.Round(DatumDbl, 0))
            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(WorksheetFunction.Round(DatumDbl, 0))
        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 = CDate(WorksheetFunction.Round(DatumDbl, 0))
            If DatumAbHalbMond = Datum Then
                MONDPHASE = "Halbmond abnehmend"
                Exit Function
            End If
        End If
    Next i
End If
End Function

Aber wie gesagt, 70 % Trefferquote, ohne Erdnähe und Erdferne des Mondes mit einzuberechnen, ist eben nur was für Hobby-Anwender ... aber dafür reicht sie absolut.