Julianisches Datum

Forumthread: Julianisches Datum

Julianisches Datum

01.03.2004 16:55:57

Rolf

Hallo
Ich muss eine Liste mit dem Julianischem Datum vom 1.1. bis 31.12. erstellen.
Der 1. Januar 2004 ist 4001.
Jeder weitere Tag plus 1.
Problem:Die Wochenenden sollen ausgeblendet Werden.
Jeder Tag muss berechnet weden (nicht weiterzählen)
Beispiel:
Jan. 04 Febr. 04
01 Do 4001 02 Mo
02 Fr 4002
05 Mo 4005
30 Fr
Danke

7
Beiträge zum Forumthread

Beiträge zu diesem Forumthread

Betreff

Datum

Anwender

AW: Julianisches Datum

01.03.2004 21:14:05

Josef Ehrensberger
RE: läuft, aber...

02.03.2004 17:33:57

Rolf
RE: läuft, aber...

02.03.2004 17:34:56

Rolf
AW: läuft, aber...

02.03.2004 17:38:10

Rolf
AW: läuft, aber...

02.03.2004 17:40:47

rolf
AW: läuft, aber...

02.03.2004 18:44:29

Josef Ehrensberger
AW: läuft, aber...

02.03.2004 19:45:56

Rolf

AW: Julianisches Datum

01.03.2004 21:14:05

Josef Ehrensberger

Hallo Rolf!
Auf eine Formellösung bin ich (noch) nicht gekommen!
Hier eine möglichkeit mit VBA.

Sub kalenderJulianisch()
'die Zellen ab "A1" bis ~"L26" werden gefüllt
Dim intJ As Integer
Dim intM As Integer
Dim intT As Integer
Dim intC As Integer
intJ = Application.InputBox("Bitte Jahr eingeben! (vierstellig)", "Jahr", Year(Date))
If IsNumeric(intJ) And intJ > 1999 And intJ < 3999 Then
For intC = 1 To 12
Cells(1, intC) = CStr(CStr(Format(DateSerial(intJ, intC, 1), "mmm.")) & " " & CStr(Format(DateSerial(intJ, intC, 1), "yy")))
Next
intT = 1
intM = 1
intC = 2
Do
If Month(DateSerial(intJ, intM, intT + 1)) > intM Then
intM = intM + 1
intT = 1
intC = 2
End If
If Weekday(DateSerial(intJ, intM, intT), vbMonday) < 6 Then
Cells(intC, intM) = CStr(CStr(Format(DateSerial(intJ, intM, intT), "dd ddd")) & " " & intJ + 1997)
intC = intC + 1
End If
intT = intT + 1
Loop While Year(DateSerial(intJ, intM, intT + 1)) = intJ
End If
End Sub

Code eingefügt mit Syntaxhighlighter 2.5

Gruß Sepp

Ein kluger Mann macht nicht alle Fehler selbst.
Er lässt auch anderen eine Chance.
(Sir Winston Churchill)

RE: läuft, aber...

02.03.2004 17:33:57

Rolf

Hallo Sepp
Nach kleinen modifikationen hat es funktioniert
Aber warum haben die Monate nur max. 30 Tage? Das gibt Fehler.
Rolf


Sub kalenderJulianisch()
'die Zellen ab "A1" bis ~"L26" werden gefüllt
Dim intju As Integer
Dim intJ As Integer
Dim intM As Integer
Dim intT As Integer
Dim intC As Integer
intJ = Application.InputBox("Bitte Jahr eingeben! (vierstellig)", "Jahr", Year(Date))
If IsNumeric(intJ) And intJ > 1999 And intJ < 3999 Then
For intC = 1 To 12
Cells(1, intC) = CStr(CStr(Format(DateSerial(intJ, intC, 1), "mmm.")) & " " & CStr(Format(DateSerial(intJ, intC, 1), "yy")))
Next
intju = 1
intT = 1
intM = 1
intC = 2
Do
If Month(DateSerial(intJ, intM, intT + 1)) > intM Then
intM = intM + 1
intT = 1
intC = 2
End If
If Weekday(DateSerial(intJ, intM, intT), vbMonday) < 6 Then
Cells(intC, intM) = CStr(CStr(Format(DateSerial(intJ, intM, intT), "dd ddd")) & "  " & ((intJ - 2000) * 1000) + intju)
intC = intC + 1
End If
intju = intju + 1
intT = intT + 1
Loop While Year(DateSerial(intJ, intM, intT + 1)) = intJ
End If
End Sub

RE: läuft, aber...

02.03.2004 17:34:56

Rolf

Hallo Sepp
Nach kleinen modifikationen hat es funktioniert
Aber warum haben die Monate nur max. 30 Tage? Das gibt Fehler.
Rolf


Sub kalenderJulianisch()
'die Zellen ab "A1" bis ~"L26" werden gefüllt
Dim intju As Integer
Dim intJ As Integer
Dim intM As Integer
Dim intT As Integer
Dim intC As Integer
intJ = Application.InputBox("Bitte Jahr eingeben! (vierstellig)", "Jahr", Year(Date))
If IsNumeric(intJ) And intJ > 1999 And intJ < 3999 Then
For intC = 1 To 12
Cells(1, intC) = CStr(CStr(Format(DateSerial(intJ, intC, 1), "mmm.")) & " " & CStr(Format(DateSerial(intJ, intC, 1), "yy")))
Next
intju = 1
intT = 1
intM = 1
intC = 2
Do
If Month(DateSerial(intJ, intM, intT + 1)) > intM Then
intM = intM + 1
intT = 1
intC = 2
End If
If Weekday(DateSerial(intJ, intM, intT), vbMonday) < 6 Then
Cells(intC, intM) = CStr(CStr(Format(DateSerial(intJ, intM, intT), "dd ddd")) & "  " & ((intJ - 2000) * 1000) + intju)
intC = intC + 1
End If
intju = intju + 1
intT = intT + 1
Loop While Year(DateSerial(intJ, intM, intT + 1)) = intJ
End If
End Sub

AW: läuft, aber...

02.03.2004 17:38:10

Rolf

Hallo Sepp
Nach kleinen modifikationen hat es funktioniert
Aber warum haben die Monate nur max. 30 Tage? Das gibt Fehler.
Rolf


Sub kalenderJulianisch()
'die Zellen ab "A1" bis ~"L26" werden gefüllt
Dim intju As Integer
Dim intJ As Integer
Dim intM As Integer
Dim intT As Integer
Dim intC As Integer
intJ = Application.InputBox("Bitte Jahr eingeben! (vierstellig)", "Jahr", Year(Date))
If IsNumeric(intJ) And intJ > 1999 And intJ < 3999 Then
For intC = 1 To 12
Cells(1, intC) = CStr(CStr(Format(DateSerial(intJ, intC, 1), "mmm.")) & " " & CStr(Format(DateSerial(intJ, intC, 1), "yy")))
Next
intju = 1
intT = 1
intM = 1
intC = 2
Do
If Month(DateSerial(intJ, intM, intT + 1)) > intM Then
intM = intM + 1
intT = 1
intC = 2
End If
If Weekday(DateSerial(intJ, intM, intT), vbMonday) < 6 Then
Cells(intC, intM) = CStr(CStr(Format(DateSerial(intJ, intM, intT), "dd ddd")) & "  " & ((intJ - 2000) * 1000) + intju)
intC = intC + 1
End If
intju = intju + 1
intT = intT + 1
Loop While Year(DateSerial(intJ, intM, intT + 1)) = intJ
End If
End Sub

AW: läuft, aber...

02.03.2004 17:40:47

rolf

sollte gar nicht 3 mal ins Forum
War ein Denkfehler

AW: läuft, aber...

02.03.2004 18:44:29

Josef Ehrensberger

Hallo Rolf!
Da war ein "+1" zweimal zuviel!
Jetzt geht's.

Sub kalenderJulianisch()
'die Zellen ab "A1" bis ~"L26" werden gefüllt
Dim intju As Integer
Dim intJ As Integer
Dim intM As Integer
Dim intT As Integer
Dim intC As Integer
intJ = Application.InputBox("Bitte Jahr eingeben! (vierstellig)", "Jahr", Year(Date))
If IsNumeric(intJ) And intJ > 1999 And intJ < 3999 Then
For intC = 1 To 12
Cells(1, intC) = CStr(CStr(Format(DateSerial(intJ, intC, 1), "mmm.")) & " " & CStr(Format(DateSerial(intJ, intC, 1), "yy")))
Next
intju = 1
intT = 1
intM = 1
intC = 2
Do
If Month(DateSerial(intJ, intM, intT)) > intM Then
intM = intM + 1
intT = 1
intC = 2
End If
If Weekday(DateSerial(intJ, intM, intT), vbMonday) < 6 Then
Cells(intC, intM) = CStr(CStr(Format(DateSerial(intJ, intM, intT), "dd ddd")) & " " & ((intJ - 2000) * 1000) + intju)
intC = intC + 1
End If
intju = intju + 1
intT = intT + 1
Loop While Year(DateSerial(intJ, intM, intT)) = intJ
End If
End Sub

Code eingefügt mit Syntaxhighlighter 2.5

Gruß Sepp

Ein kluger Mann macht nicht alle Fehler selbst.
Er lässt auch anderen eine Chance.
(Sir Winston Churchill)

Beliebteste Forumthreads (12 Monate)

Forumthread: Julianisches Datum

7 Beiträge zum Forumthread Beiträge zu diesem Forumthread

Beliebteste Forumthreads (12 Monate)

7
Beiträge zum Forumthread

Beiträge zu diesem Forumthread