AW: Sonnenaufgang
03.07.2006 19:46:42
Bernd
hi thomas,
hier, habe ich auch aus dem forum.
autor ist mir leider nicht mehr bekannt.
erkläre dir die formel selbst ;)
|
| |
| | A | B | C | D | | 1 | Länge | 10 | | | | 2 | Breite | 54 | | | | 3 | Tag | 03.07.2006 | | | | 4 | Tag des Jahres | 184 | | | | 5 | | | | | | 6 | | Formel | Funktion | | | 7 | Zeit Sonnenaufgang | 03.07.2006 04:54 | 03.07.2006 04:54 | | | 8 | Zeit Sonnenuntergang | 03.07.2006 21:53 | 03.07.2006 21:53 | | | 9 | | | | | | Formeln der Tabelle | B3 : =HEUTE()
B4 : =B3-DATUM(JAHR(B3);1;0)
B7 : =ToSommerWinterzeit($B$3+(12-(12*ARCCOS((SIN(-0,0145)-SIN($B$2*PI()/180)*SIN(0,40954*SIN(0,0172*(($B$3-DATUM(JAHR($B$3);1;0))-79,35))))/(COS($B$2*PI()/180)*COS(0,40954*SIN(0,0172*(($B$3-DATUM(JAHR($B$3);1;0))-79,35)))))/PI())-(-0,1752*SIN(0,03343*($B$3-DATUM(JAHR($B$3);1;0))+0,5474)-0,134*SIN(0,018234*($B$3-DATUM(JAHR($B$3);1;0))-0,1939))+(15-$B$1)*4/60)/24)
C7 : =ToSommerWinterzeit($B$3+Sonnenaufgang(B1;B2;B3))
B8 : =ToSommerWinterzeit($B$3+(12+(12*ARCCOS((SIN(-0,0145)-SIN($B$2*PI()/180)*SIN(0,40954*SIN(0,0172*(($B$3-DATUM(JAHR($B$3);1;0))-79,35))))/(COS($B$2*PI()/180)*COS(0,40954*SIN(0,0172*(($B$3-DATUM(JAHR($B$3);1;0))-79,35)))))/PI())-(-0,1752*SIN(0,03343*($B$3-DATUM(JAHR($B$3);1;0))+0,5474)-0,134*SIN(0,018234*($B$3-DATUM(JAHR($B$3);1;0))-0,1939))+(15-$B$1)*4/60)/24)
C8 : =ToSommerWinterzeit($B$3+Sonnenuntergang(B1;B2;B3))
|
|
| |
hier der code für die funktionen:
der code kommt vom selben autor wie die formel.
einfach in ein modul schreiben.
Option Explicit
Public
Function Sonnenaufgang( _
Längengrad As Double, _
Breitengrad As Double, _
Datum As Date) As Date
Dim Deklination As Double, DiffWozMoz As Double
Dim Jahrestag As Double, H_aufgang As Double
Dim DiffMittag As Double, dummy As Double
Const Pi = 3.141592653
'Sonnenaufgang bei -50 Bogenminuten
H_aufgang = (-50 / 60) * Pi / 180
'Tag des Jahres
Jahrestag = Datum - DateSerial(Year(Datum), 1, 0)
Breitengrad = Breitengrad * Pi / 180
Längengrad = Längengrad * Pi / 180
'Breitengrad, über dem die Sonne Mittags senkrecht steht
Deklination = 0.40954 * Sin(0.0172 * (Jahrestag - 79.35))
'Differenz zum Mittag in Stunden berechnen
dummy = (Sin(H_aufgang) - Sin(Breitengrad) * Sin(Deklination)) _
/ (Cos(Breitengrad) * Cos(Deklination))
DiffMittag = 12 * (Atn((dummy * -1) / _
Sqr(dummy * -1 * dummy + 1)) _
+ 2 * Atn(1)) / Pi
DiffWozMoz = -0.1752 * Sin(0.03343 * Jahrestag + 0.5474) _
- 0.134 * Sin(0.018234 * Jahrestag - 0.1939)
Sonnenaufgang = (12 - DiffMittag - DiffWozMoz + _
(15 - Längengrad * 180 / Pi) * 4 / 60) / 24
End Function
Public
Function Sonnenuntergang( _
Längengrad As Double, _
Breitengrad As Double, _
Datum As Date) As Date
Dim Deklination As Double, DiffWozMoz As Double
Dim Jahrestag As Double, H_aufgang As Double
Dim DiffMittag As Double, dummy As Double
Const Pi = 3.141592653
'Sonnenuntergang bei -50 Bogenminuten
H_aufgang = (-50 / 60) * Pi / 180
'Tag des Jahres
Jahrestag = Datum - DateSerial(Year(Datum), 1, 0)
Breitengrad = Breitengrad * Pi / 180
Längengrad = Längengrad * Pi / 180
'Breitengrad, über dem die Sonne Mittags senkrecht steht
Deklination = 0.40954 * Sin(0.0172 * (Jahrestag - 79.35))
'Differenz zum Mittag in Stunden berechnen
dummy = (Sin(H_aufgang) - Sin(Breitengrad) * Sin(Deklination)) _
/ (Cos(Breitengrad) * Cos(Deklination))
DiffMittag = 12 * (Atn((dummy * -1) / _
Sqr(dummy * -1 * dummy + 1)) _
+ 2 * Atn(1)) / Pi
DiffWozMoz = -0.1752 * Sin(0.03343 * Jahrestag + 0.5474) _
- 0.134 * Sin(0.018234 * Jahrestag - 0.1939)
Sonnenuntergang = (12 + DiffMittag - DiffWozMoz + _
(15 - Längengrad * 180 / Pi) * 4 / 60) / 24
End Function
Public
Function ToSommerWinterzeit(DatumZeit As Date) As Date
Dim Beginn As Date, Ende As Date, Jahr&
Jahr = Year(DatumZeit)
Beginn = DateSerial(Jahr, 4, 0) - (WeekDay( _
DateSerial(Jahr, 4, 0), 2) Mod 7) + TimeSerial(1, 0, 0)
Ende = DateSerial(Jahr, 11, 0) - (WeekDay( _
DateSerial(Jahr, 11, 0), 2) Mod 7) + TimeSerial(1, 0, 0)
If DatumZeit > Beginn And DatumZeit < Ende Then
ToSommerWinterzeit = DatumZeit + TimeSerial(1, 0, 0)
Else
ToSommerWinterzeit = DatumZeit
End If
End Function
gruss Bernd