PDA

Vollständige Version anzeigen : Kalenderwochen


TommyK
09.12.2003, 15:27
Hallo,


immer wieder ein Thema ist im Forum der Umgang mit Kalenderwochen.

Die Errechnung der Kalenderwoche (KW) aus einem Datum geht ja noch.

Wobei die pure Formatierung eines Datums in die KW auch Fehler bei Berechnung von Jahreswechseln beinhaltet.
Syntax:
<div><link href="http://www.ms-office-forum.net/forum/externals/codeconv.css" rel="stylesheet"><pre><span class="TOKEN">Dim</span> varKW <span class="TOKEN">As</span> Variant
&nbsp;
varKW = Format(&quot;DeinDatum&quot;, &quot;ww&quot;, vbMonday)
&nbsp;
<span class="REM"> 'oder</span>
&nbsp;
varKW = Format(&quot;DeinDatum&quot;, &quot;ww/yyyy&quot;, vbMonday)</pre></div>

Genauere Ergebnisse erhält man dann schon mit speziellen Funktionen:
<div><link href="http://www.ms-office-forum.net/forum/externals/codeconv.css" rel="stylesheet"><pre><span class="TOKEN">Function</span> Kalenderwoche(XDatum <span class="TOKEN">As</span> Variant) <span class="TOKEN">As</span> <span class="TOKEN">String</span>
<span class="REM">'Gibt Ein Datum als &quot;ww\jjjj&quot; String zur&uuml;ck</span>
<span class="REM">'Wenn eine Wochennummer in ein unterschiedliches Jahr f&auml;llt, so wird dies ber&uuml;cksichtigt</span>
<span class="REM">'d.h. 31.12.2002 = 01\2003 bzw. 1.1.1999 = 53\1998</span>
<span class="TOKEN">Dim</span> x, Y, Z
Kalenderwoche = &quot;&quot;
<span class="TOKEN">If</span> <span class="TOKEN">Not</span> IsDate(XDatum) <span class="TOKEN">Then</span> Kalenderwoche = &quot;&quot;: <span class="TOKEN">Exit Function</span>
XDatum = <span class="TOKEN">CDate</span>(XDatum)
x = Year(XDatum)
Y = Month(XDatum)
Z = Format(XDatum, &quot;ww&quot;, vbMonday, vbFirstFourDays)
<span class="TOKEN">If</span> Z &gt; 52 <span class="TOKEN">Then</span>
<span class="TOKEN">If</span> Format(XDatum + 7, &quot;ww&quot;, vbMonday, vbFirstFourDays) = 2 <span class="TOKEN">Then</span> Z = 1
<span class="TOKEN">End</span> <span class="TOKEN">If</span>
<span class="TOKEN">If</span> Y = 12 <span class="TOKEN">And</span> Z &lt; 40 <span class="TOKEN">Then</span> x = x + 1
<span class="TOKEN">If</span> Y = 1 <span class="TOKEN">And</span> Z &gt; 10 <span class="TOKEN">Then</span> x = x - 1
Kalenderwoche = Right(&quot;00&quot; &amp; Z, 2) &amp; &quot;/&quot; &amp; Right(&quot;0000&quot; &amp; x, 4)
<span class="TOKEN">End</span> <span class="TOKEN">Function</span></pre></div>
In dieser Funktion werden Jahreswechsel richtig berechnet.
Folgende Argumente müssen übergeben werden:

XDatum= ein formatiertes Datum (sonst gibt die Funktion "" zurück)
boolModus True =Format "ww/jjjj", False =Format "ww"

Syntax:
Dim Testdatum as Date
Dim strKW as String
Testdatum = #12/31/2002# ' Test mit 31.12.2002
strKW = Kalenderwoche(Testdatum, True)

Jetzt kommen wir aber zur rekursiven Berechnung, sprich ein Datum aus einer KW zu ermitteln.
Drei Argumente werden benötigt, die KW, das Jahr und den Wochentag.
Die Funktion "GetDateFromWeek" gibt dann das Datum zurück.
<div><link href="http://www.ms-office-forum.net/forum/externals/codeconv.css" rel="stylesheet"><pre><span class="TOKEN">Public Function</span> GetDateFromWeek(<span class="TOKEN">ByVal</span> nWeek <span class="TOKEN">As</span> Integer, nDayOfWeek <span class="TOKEN">As</span> Integer, _
<span class="TOKEN">Optional</span> <span class="TOKEN">ByVal</span> nYear <span class="TOKEN">As</span> <span class="TOKEN">Integer</span> = -1)
<span class="REM">'*******************************************</span>
<span class="REM">'Name: GetDateFromWeek (Function)</span>
<span class="REM">'Purpose:</span>
<span class="REM">'Author: Dieter Otter, angepasst an VBA von Thomas Ke&szlig;ler</span>
<span class="REM">'Date:</span>
<span class="REM">'Called by:</span>
<span class="REM">'Calls:</span>
<span class="REM">'Inputs:</span>
<span class="REM">'Output:</span>
<span class="REM">'Example: vMonday = GetDateFromWeek(12, vbMonday, 2003)</span>
<span class="REM">'*******************************************</span>
&nbsp;
<span class="TOKEN">Dim</span> nCurWeek <span class="TOKEN">As</span> <span class="TOKEN">Integer</span>
<span class="TOKEN">Dim</span> vStart <span class="TOKEN">As</span> Variant
<span class="TOKEN">Dim</span> vStart1 <span class="TOKEN">As</span> Variant
<span class="TOKEN">Dim</span> vMonday <span class="TOKEN">As</span> Variant
<span class="TOKEN">Dim</span> vSunday <span class="TOKEN">As</span> Variant
<span class="TOKEN">Dim</span> nDay <span class="TOKEN">As</span> <span class="TOKEN">Integer</span>
&nbsp;
Select Case nDayOfWeek
Case <span class="TOKEN">Is</span> = 1
nDayOfWeek = vbMonday
Case <span class="TOKEN">Is</span> = 2
nDayOfWeek = vbTuesday
Case <span class="TOKEN">Is</span> = 3
nDayOfWeek = vbWednesday
Case <span class="TOKEN">Is</span> = 4
nDayOfWeek = vbThursday
Case <span class="TOKEN">Is</span> = 5
nDayOfWeek = vbFriday
Case <span class="TOKEN">Is</span> = 6
nDayOfWeek = vbSaturday
Case <span class="TOKEN">Is</span> = 7
nDayOfWeek = vbSunday
<span class="TOKEN">End</span> Select
&nbsp;
<span class="REM"> ' Kein Jahr angeben? Dann aktuelles Jahr verwenden!</span>
<span class="TOKEN">If</span> nYear = -1 <span class="TOKEN">Then</span> nYear = Year(Date)
&nbsp;
<span class="REM"> ' aktuelle Woche im Jahr nYear ermitteln</span>
vStart1 = DateSerial(nYear, Month(Date), Day(Date))
nCurWeek = Kalenderwoche(vStart1, <span class="TOKEN">False</span>)
&nbsp;
<span class="REM"> ' Datum der gew&uuml;nschten Woche ermitteln</span>
vStart = DateAdd(&quot;ww&quot;, nWeek - nCurWeek, vStart1)
&nbsp;
<span class="REM"> ' Wochenanfang ermitteln</span>
nDay = WeekDay(vStart, vbMonday)
&nbsp;
<span class="REM"> ' Datum des gew&uuml;nschten Wochentags ermitteln</span>
<span class="TOKEN">If</span> nDayOfWeek = vbSunday <span class="TOKEN">Then</span>
GetDateFromWeek = DateAdd(&quot;d&quot;, -nDay + 7, vStart)
<span class="TOKEN">Else</span>
GetDateFromWeek = DateAdd(&quot;d&quot;, -nDay + nDayOfWeek - 1, vStart)
<span class="TOKEN">End</span> <span class="TOKEN">If</span>
<span class="TOKEN">End</span> <span class="TOKEN">Function</span></pre></div>
Argumente:

nWeek= KW z.B 50
nDayOfWeek= Wochentag z.B. 1=Montag
nYear=Jahr z.B. 2003

Syntax:
Dim varDate As Variant
Dim intWeek As Integer
Dim intDay As Integer
Dim intYear As Integer

intWeek = 50 ' 50.KW
intDay = 1 ' Montag
intYear = 2003 ' 2003

varDate = GetDateFromWeek(intWeek, intDay, intYear)

' varDate wäre = 08.12.2003

Jetzt kann man noch alle Tage der gewählen KW in einem Listenfeld anzeigen lassen. (s. Bsp-DB)
Das Füllen des Listenfeldes soll hier aber jetzt nicht näher beschrieben werden, da dies ein extra Thema ergibt.

Ich hoffe Ihr könnt damit etwas anfangen.

Auch würden wir uns, also J. Eilers und ich, über einige Feedbacks zu den hier vorgestellten Bsp freuen.
Egal ob negativer oder positiver Natur.

Hier gehts zum Download: Berechnung Kalenderwochen (http://www.ms-office-forum.net/daten/access/12_2003/112272.zip)

stpimi
11.12.2003, 09:01
Da muss ich kurz mal meinen Senf dazugeben:

Zur Berechnung der Kalenderwoche nach DIN 1355 bitte noch hier nachlesen (http://support.microsoft.com/default.aspx?scid=kb%3Bde%3BD33405) !

Und um dem Urheberrecht Genüge zu tun:
Der Link ist geklaut aus einem Beitrag von jinx im Excel-Forum - Danke ;) ;)

Mfg, Michael

TommyK
02.01.2004, 14:56
Hallo,

bezugnehmend auf den Thread (http://www.ms-office-forum.net/forum/showthread.php?s=&postid=479090)
habe ich den beschriebenen Fehler in der Bsp-DB korrigiert.

TommyK
03.02.2004, 13:50
Hallo,

ich habe aufgrund dieses Threads (http://www.ms-office-forum.net/forum/showthread.php?s=&threadid=113877 ) nochmal die
Funktion überarbeitet.
Jetzt wurde auch der Fehler aus o.g. Thread beseitigt.
Die neue Funktion sieht jetzt so aus:
<div><link href="http://www.ms-office-forum.net/forum/externals/codeconv.css" rel="stylesheet"><pre><span class="TOKEN">Function</span> Kalenderwoche(XDatum <span class="TOKEN">As</span> Variant, fModus <span class="TOKEN">As</span> <span class="TOKEN">Boolean</span>) <span class="TOKEN">As</span> <span class="TOKEN">String</span>
<span class="TOKEN">Dim</span> x, y, z
Kalenderwoche = &quot;&quot;
<span class="TOKEN">If</span> <span class="TOKEN">Not</span> IsDate(XDatum) <span class="TOKEN">Then</span> Kalenderwoche = &quot;&quot;: <span class="TOKEN">Exit Function</span>
XDatum = <span class="TOKEN">CDate</span>(XDatum)
x = Year(XDatum)
z = Format(XDatum, &quot;ww&quot;, vbMonday, vbFirstFourDays)
y = Int((XDatum - DateSerial(Year(XDatum), 1, 1) + ((WeekDay(DateSerial(Year(XDatum), 1, 1)) + 1) Mod 7) - 3) / 7) + 1
&nbsp;
<span class="TOKEN">If</span> y = 0 <span class="TOKEN">Then</span>
z = Format(DateSerial(x - 1, 12, 31), &quot;ww&quot;, vbMonday, vbFirstFourDays)
<span class="TOKEN">If</span> z &gt;= 52 <span class="TOKEN">Then</span> x = x - 1
<span class="TOKEN">ElseIf</span> y &gt; 52 <span class="TOKEN">And</span> (WeekDay(DateSerial(x, 12, 31)) - 1) Mod 7 &lt;= 3 <span class="TOKEN">Then</span>
<span class="TOKEN">If</span> Format(XDatum + 7, &quot;ww&quot;, vbMonday, vbFirstFourDays) = 2 <span class="TOKEN">Then</span> z = 1
<span class="TOKEN">If</span> z = 1 <span class="TOKEN">Then</span> x = x + 1
<span class="TOKEN">End</span> <span class="TOKEN">If</span>
<span class="TOKEN">If</span> fModus = <span class="TOKEN">True</span> <span class="TOKEN">Then</span>
Kalenderwoche = Right(&quot;00&quot; &amp; z, 2) &amp; &quot;/&quot; &amp; Right(&quot;0000&quot; &amp; x, 4)
<span class="TOKEN">Else</span>
Kalenderwoche = Right(&quot;00&quot; &amp; z, 2)
<span class="TOKEN">End</span> <span class="TOKEN">If</span>
<span class="TOKEN">End</span> <span class="TOKEN">Function</span></pre></div>
Code eingefügt mit dem MOF Code Converter (http://www.ms-office-forum.net/forum/codeconverter.php)

Der Download wurde aktualisiert.

Re
04.01.2005, 15:30
Hallo Tommy,

nach der Angabe in Deinem vorherigen Thread funktioniert es. Das Download Beispiel bringt aber ein falsches Datum

KW 1 Jahr 2005 Wochentag Montag Datum 27.12.2004

Vielen Dank für Eure schnelle Reaktion

Renate

TommyK
05.01.2005, 05:37
Danke Renate,

ist mir auch erst gestern aufgefallen, nach einem Hinweis eines anderen Users.
Hab den Download auf meiner HP schon korrigiert.
Hier im MOF wird er heute noch erneuert.
Aktueller Download hier: Berechnung von Kalenderwochen (DIN 1355) (http://www.access-beispiele.tommyk-webbox.de/bsp_datetime.php#kw)