Guten Tag Leute,
ich stehe vor einem Problem. Ich muss für die Auswertung von Wildkamerafotos, die am Tag des Entstehen des Fotos herrschende Mondphase in Excel integrieren.
Kurze Erklärung:
Ich bin damit beauftragt worden, die EXIF-Daten von Bildern aus Wildkameras auszulesen und diese dann in Excel zu strukturieren. Dafür gibt es entsprechende Programme, die den Workflow erheblich vereinfachen. Die Kamera selber zeigt auf dem Foto die aktuelle Mondphase an, speichert diese aber nicht in den EXIF-Daten und kann somit nicht von der Software ausgelesen werden.
Bevor man jetzt in jede Zeile händisch die Mondphase einträgt wäre es schöner, wenn man eine Funkton erstellt, die passend zum jeweiligen Datum selbstständig "herausfindet", welche Mondphase dort herrschte.
Beispiel: Foto entstanden am 27.08.2019 -> Vollmond
Foto entstanden am 23.06.2019 -> Neumond usw.
Meine Excel Grundladen liegen einige Jahre zurück, daher stehe ich mit eigenen Überlegungen und Umsetzungen aktuell vor einer Wand.
Ich hoffe, dass ich es einigermaßen verständlich erklärt habe.
Liebe Grüße
Hendrik
Hallo Hendrikq,
falls dir eine näherungsweise Ermittlung (+/- 1 Tag) reicht, dann kann evtl. geholfen werden.
Das wäre für wissenschaftliche Zwecke jedoch nicht zu gebrauchen. Die genaue Ermittlung (inkl. Berücksichtigung der Sommerzeiten) ist zu komplex für mich.
Sigi
Hallo,
habe mich auch schon mal damit beschäftigt und die Mondphasen in einen Kalender eingebaut.
Im Anhang die Berechnung.
Vielleicht reicht dir das.
MfG Günter
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
(23.04.2020, 10:42)Sigi.21 schrieb: [ -> ]Hallo Hendrikq,
falls dir eine näherungsweise Ermittlung (+/- 1 Tag) reicht, dann kann evtl. geholfen werden.
Das wäre für wissenschaftliche Zwecke jedoch nicht zu gebrauchen. Die genaue Ermittlung (inkl. Berücksichtigung der Sommerzeiten) ist zu komplex für mich.
Sigi
Vielen Dank für deine Antwort. Ich befürchte jedoch, wie Du schon selber gesagt hast, dass dies für wissenschaftliche Zwecke nicht ausreicht.
Trotzdem nochmals besten Dank und liebe Grüße!
(23.04.2020, 16:41)Flotter Feger schrieb: [ -> ]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
Vielen Dank für die Antwort. Ich werde es mal ausprobieren!
(23.04.2020, 10:49)redeagle56 schrieb: [ -> ]Hallo,
habe mich auch schon mal damit beschäftigt und die Mondphasen in einen Kalender eingebaut.
Im Anhang die Berechnung.
Vielleicht reicht dir das.
MfG Günter
Hi Günter,
vielen lieben Dank! Ich werde es mir mal anschauen und gucken, ob ich es damit hinbekomme!
LG
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.