MS-Office-Forum

Zurück   MS-Office-Forum > Microsoft Access & Datenbanken > Microsoft Access - Code Archiv
Registrieren Forum Hilfe Alle Foren als gelesen markieren

Banner und Co.

Antworten
Ads
Themen-Optionen Ansicht
Alt 09.12.2003, 15:27   #1
TommyK
MOF Meister
MOF Meister
Standard Codebeispiel - Kalenderwochen

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:
Code:

Dim varKW As Variant
 
    varKW = Format("DeinDatum", "ww", vbMonday)
 
    'oder
 
    varKW = Format("DeinDatum", "ww/yyyy", vbMonday)
Genauere Ergebnisse erhält man dann schon mit speziellen Funktionen:
Code:

Function Kalenderwoche(XDatum As Variant) As String
'Gibt Ein Datum als "ww\jjjj" String zurück
'Wenn eine Wochennummer in ein unterschiedliches Jahr fällt, so wird dies berücksichtigt
'd.h. 31.12.2002 = 01\2003 bzw. 1.1.1999 = 53\1998
Dim x, Y, Z
    Kalenderwoche = ""
If Not IsDate(XDatum) Then Kalenderwoche = "": Exit Function
    XDatum = CDate(XDatum)
    x = Year(XDatum)
    Y = Month(XDatum)
    Z = Format(XDatum, "ww", vbMonday, vbFirstFourDays)
    If Z > 52 Then
        If Format(XDatum + 7, "ww", vbMonday, vbFirstFourDays) = 2 Then Z = 1
    End If
    If Y = 12 And Z < 40 Then x = x + 1
    If Y = 1 And Z > 10 Then x = x - 1
    Kalenderwoche = Right("00" & Z, 2) & "/" & Right("0000" & x, 4)
End Function
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:
Code:

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.
Code:

Public Function GetDateFromWeek(ByVal nWeek As Integer, nDayOfWeek As Integer, _
                Optional ByVal nYear As Integer = -1)
'*******************************************
'Name:      GetDateFromWeek (Function)
'Purpose:
'Author:    Dieter Otter, angepasst an VBA von Thomas Keßler
'Date:
'Called by:
'Calls:
'Inputs:
'Output:
'Example: vMonday = GetDateFromWeek(12, vbMonday, 2003)
'*******************************************
 
  Dim nCurWeek As Integer
  Dim vStart As Variant
  Dim vStart1 As Variant
  Dim vMonday As Variant
  Dim vSunday As Variant
  Dim nDay As Integer
 
  Select Case nDayOfWeek
    Case Is = 1
        nDayOfWeek = vbMonday
    Case Is = 2
        nDayOfWeek = vbTuesday
    Case Is = 3
        nDayOfWeek = vbWednesday
    Case Is = 4
        nDayOfWeek = vbThursday
    Case Is = 5
        nDayOfWeek = vbFriday
    Case Is = 6
        nDayOfWeek = vbSaturday
    Case Is = 7
        nDayOfWeek = vbSunday
    End Select
 
  ' Kein Jahr angeben? Dann aktuelles Jahr verwenden!
  If nYear = -1 Then nYear = Year(Date)
 
  ' aktuelle Woche im Jahr nYear ermitteln
  vStart1 = DateSerial(nYear, Month(Date), Day(Date))
  nCurWeek = Kalenderwoche(vStart1, False)
 
  ' Datum der gewünschten Woche ermitteln
  vStart = DateAdd("ww", nWeek - nCurWeek, vStart1)
 
  ' Wochenanfang ermitteln
  nDay = WeekDay(vStart, vbMonday)
 
  ' Datum des gewünschten Wochentags ermitteln
  If nDayOfWeek = vbSunday Then
    GetDateFromWeek = DateAdd("d", -nDay + 7, vStart)
  Else
    GetDateFromWeek = DateAdd("d", -nDay + nDayOfWeek - 1, vStart)
  End If
End Function
Argumente:

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


Syntax:
Code:

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

__________________

Gruss TommyK

TKSoft-Online | Beispiele im MOF Code-Archiv
Meine Software:Windows 10 Pro 64Bit, Windows 7 Ultimate 64Bit, Office 2007 Pro SP2, Office 2010 Pro, Office 2013 Pro, Office 2016 Pro, Office 2019 Pro, VB6 Pro SP6, VS2017
TommyK ist offline  
verlinken auf Del.icio.us Diese Seite zu Mister Wong hinzufügen
Antworten Auf Beitrag antworten
Alt 11.12.2003, 09:01   #2
stpimi
MOF Meister
MOF Meister
Standard

Da muss ich kurz mal meinen Senf dazugeben:

Zur Berechnung der Kalenderwoche nach DIN 1355 bitte noch hier nachlesen !

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

Mfg, Michael

__________________

Mfg, Michael

Alte Programmiererweisheit: Kaum macht man's richtig, funktioniert es schon ....

PS: Dein Feedback hilft allen weiter - vergiss es nicht ...!!

(Systemumgebung: Windows XP, Office XP/2003)

relationale Datenbanken | FAQ | Reinhard Kraasch | Access-Grundlagen | Uploads | DB-Wiki |Die 10 Access-Gebote | Makros - besser nicht!
stpimi ist offline  
verlinken auf Del.icio.us Diese Seite zu Mister Wong hinzufügen
Antworten Auf Beitrag antworten
Alt 02.01.2004, 14:56   #3
TommyK
Threadstarter Threadstarter
MOF Meister
MOF Meister
Standard

Hallo,

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

__________________

Gruss TommyK

TKSoft-Online | Beispiele im MOF Code-Archiv
Meine Software:Windows 10 Pro 64Bit, Windows 7 Ultimate 64Bit, Office 2007 Pro SP2, Office 2010 Pro, Office 2013 Pro, Office 2016 Pro, Office 2019 Pro, VB6 Pro SP6, VS2017
TommyK ist offline  
verlinken auf Del.icio.us Diese Seite zu Mister Wong hinzufügen
Antworten Auf Beitrag antworten
Alt 03.02.2004, 13:50   #4
TommyK
Threadstarter Threadstarter
MOF Meister
MOF Meister
Standard

Hallo,

ich habe aufgrund dieses Threads (http://www.ms-office-forum.net/forum...hreadid=113877 ) nochmal die
Funktion überarbeitet.
Jetzt wurde auch der Fehler aus o.g. Thread beseitigt.
Die neue Funktion sieht jetzt so aus:
Code:

Function Kalenderwoche(XDatum As Variant, fModus As Boolean) As String
Dim x, y, z
    Kalenderwoche = ""
If Not IsDate(XDatum) Then Kalenderwoche = "": Exit Function
    XDatum = CDate(XDatum)
    x = Year(XDatum)
    z = Format(XDatum, "ww", vbMonday, vbFirstFourDays)
    y = Int((XDatum - DateSerial(Year(XDatum), 1, 1) + ((WeekDay(DateSerial(Year(XDatum), 1, 1)) + 1) Mod 7) - 3) / 7) + 1
 
    If y = 0 Then
        z = Format(DateSerial(x - 1, 12, 31), "ww", vbMonday, vbFirstFourDays)
        If z >= 52 Then x = x - 1
    ElseIf y > 52 And (WeekDay(DateSerial(x, 12, 31)) - 1) Mod 7 <= 3 Then
        If Format(XDatum + 7, "ww", vbMonday, vbFirstFourDays) = 2 Then z = 1
        If z = 1 Then x = x + 1
    End If
    If fModus = True Then
        Kalenderwoche = Right("00" & z, 2) & "/" & Right("0000" & x, 4)
    Else
        Kalenderwoche = Right("00" & z, 2)
    End If
End Function
Code eingefügt mit dem MOF Code Converter

Der Download wurde aktualisiert.

__________________

Gruss TommyK

TKSoft-Online | Beispiele im MOF Code-Archiv
Meine Software:Windows 10 Pro 64Bit, Windows 7 Ultimate 64Bit, Office 2007 Pro SP2, Office 2010 Pro, Office 2013 Pro, Office 2016 Pro, Office 2019 Pro, VB6 Pro SP6, VS2017
TommyK ist offline  
verlinken auf Del.icio.us Diese Seite zu Mister Wong hinzufügen
Antworten Auf Beitrag antworten
Alt 04.01.2005, 15:30   #5
Re
MOF Profi
MOF Profi
Standard

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
Re ist offline  
verlinken auf Del.icio.us Diese Seite zu Mister Wong hinzufügen
Antworten Auf Beitrag antworten
Alt 05.01.2005, 05:37   #6
TommyK
Threadstarter Threadstarter
MOF Meister
MOF Meister
Standard

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)

__________________

Gruss TommyK

TKSoft-Online | Beispiele im MOF Code-Archiv
Meine Software:Windows 10 Pro 64Bit, Windows 7 Ultimate 64Bit, Office 2007 Pro SP2, Office 2010 Pro, Office 2013 Pro, Office 2016 Pro, Office 2019 Pro, VB6 Pro SP6, VS2017
TommyK ist offline  
verlinken auf Del.icio.us Diese Seite zu Mister Wong hinzufügen
Antworten Auf Beitrag antworten
Ads
Antworten


Aktive Benutzer in diesem Thema: 1 (Registrierte Benutzer: 0, Besucher: 1)
 
Themen-Optionen
Ansicht

Forumregeln
Es ist Ihnen nicht erlaubt, neue Themen zu verfassen.
Es ist Ihnen nicht erlaubt, auf Beiträge zu antworten.
Es ist Ihnen nicht erlaubt, Anhänge anzufügen.
Es ist Ihnen nicht erlaubt, Ihre Beiträge zu bearbeiten.

vB Code ist An.
Smileys sind An.
[IMG] Code ist An.
HTML-Code ist An.
Gehe zu


Alle Zeitangaben in WEZ +1. Es ist jetzt 10:17 Uhr.



Powered by: vBulletin Version 3.6.2 (Deutsch)
Copyright ©2000 - 2019, Jelsoft Enterprises Ltd.

Copyright ©2000-2018 MS-Office-Forum. Alle Rechte vorbehalten.
Copyright ©Design: Manuela Kulpa ©Rechte: Günter Kramer
Eine Verwendung der Inhalte in anderen Publikationen, auch auszugsweise,
ist ohne ausdrückliche Zustimmung der Autoren nicht gestattet.