Live-Forum - Die aktuellen Beiträge
Anzeige
Archiv - Navigation
388to392
Aktuelles Verzeichnis
Verzeichnis Index
Übersicht Verzeichnisse
Vorheriger Thread
Rückwärts Blättern
Nächster Thread
Vorwärts blättern
Anzeige
HERBERS
Excel-Forum (Archiv)
20+ Jahre Excel-Kompetenz: Von Anwendern, für Anwender
388to392
388to392
Aktuelles Verzeichnis
Verzeichnis Index
Verzeichnis Index
Übersicht Verzeichnisse
Inhaltsverzeichnis

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
Anzeige
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)


Anzeige
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

Anzeige
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

Anzeige
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

Anzeige
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)


Anzeige
AW: läuft, aber...
02.03.2004 19:45:56
Rolf
OK. Jetzt läufts

Beliebteste Forumthreads (12 Monate)

Anzeige

Beliebteste Forumthreads (12 Monate)

Anzeige
Anzeige
Anzeige