« Immer wenn ich ein wenig Zeit habe | Main| Heute wurde mir die folgende Frage gestellt »

Immer wieder Sonntags

0
Category

Bin ich auch der Suche nach der Berechnung einer Kalenderwoche... Der Code wurde von mir schon viele Male geschrieben, aber meistens ist es einfacher diesen Code mit Google zu finden. .....

Damit es im großen Netz eine Stelle mehr zum Finden existiert hier noch einmal der Code:

'.fwrkLSDate:

Option Public
Option
Explicit



Function GetCalendarWeek( Byval inputdate As Variant ) As String
       
%REM

This function calculates the calendar week number
(ISO standard) for a given date value. The format
function of LotusScript (parameter "ww") does not solve
this problem.

Monday is the first day of the week. Week #1 is the week
that contains the 4th of January (ISO 8601). The week at the
end/beginning of the year belongs to the next/previous year,
if there are 3 days or less of that week in the year in question.

Christian Meis, 4.2.2000
%END REM
       
       
Dim InputDateOffset As Integer
       Dim
YearInQuestion As Integer
       Dim
January4 As Variant
       Dim
January4Offset As Integer
       Dim
FirstMondayOfYear As Variant
       Dim
January1Offset As Integer
       Dim
December31Offset As Integer
       Dim
weeknum As Integer
       
 
' The year value is preset with that of the input date
       
YearInQuestion = Year( inputdate )
       
 
' Calculate offset to monday from the input date
       
InputDateOffset = CalculateIsoWeekday( inputdate )
       
 
' Calculate offsets for the first/last day of the year
       
January1Offset = CalculateIsoWeekday( Cdat( "01.01." & Cstr( YearInQuestion ) ) )
       
December31Offset = CalculateIsoWeekday( Cdat( "31.12." & Cstr( YearInQuestion  ) ) )
       
 
' If the input date is before the 4th of January and the year starts with
 ' a friday, saturday or sunday, the week belongs to the previous year
 ' if the entered date is not a monday or tuesday
       
If Month( inputdate ) = 1 And Day( inputdate ) < 4 And January1Offset> 3 And InputDateOffset > 1 Then
               
YearInQuestion = YearInQuestion - 1
       
End If
       
 
' If the input date is after the 28th of December and the year ends with
 ' a monday, tuesday or wednesday, then the week belongs to the following year
 ' if the entered date is not a saturday or sunday
       
If Month( inputdate ) = 12 And Day( inputdate ) > 28 And December31Offset < 3 And InputDateOffset < 5 Then
               
YearInQuestion = YearInQuestion + 1
       
End If
       
 
' The 4th of January defines week #1
       
January4 = Cdat( "04.01." & Cstr( YearInQuestion ) )
       
 
' Offset to the monday of week #1
       
FirstMondayOfYear = Cdat( January4 - CalculateIsoWeekday( January4 ) )
       
 
' The time range between the monday of week #1 and the monday
 ' of the week in question is divided by 7, plus 1 for the first week
       
weeknum = ( inputdate - InputDateOffset - FirstMondayOfYear ) \ 7 + 1
       
 
' The return value is a string with the week number and the year
       
GetCalendarWeek = Cstr( YearInQuestion ) & "/" & Right("0" + Cstr( weeknum ),2)
       
End Function
Function
CalculateIsoWeekday( tmpdate As Variant ) As Integer
       
%REM

This function converts the weekday-numbers from the
standard function to an offset acc. to the ISO version
monday -> 0, ... , sunday -> 6
%END REM
       
       
Dim n As Integer
       
       
n = Weekday( tmpdate )
       
       If
n = 1 Then ' sunday to end of week
               
n = n + 7
       
End If
       
       
CalculateIsoWeekday = n - 2
       
End Function

Gruß JJR

P.S.: Werde, unter der Bedingung des Nicht-Vergessens, diese in das nächste Release von ODA einbinden.


Post A Comment

:-D:-o:-p:-x:-(:-):-\:angry::cool::cry::emb::grin::huh::laugh::lips::rolleyes:;-)

Amazon


Impressum

Firmenname: Peanuts-Soft
Straße Nummer: Biinger Strasse 8
PLZ Ort: 55263 Wackernheim
Telefon: +491772134526
E-Mail: joerg.reck @ peanuts-soft.de
Disclaimer: Peanuts-Soft übernimmt keine Garantie dafür, dass die auf dieser Website bereitgestellten Informationen vollständig, richtig und stets aktuell sind. Dies gilt auch für alle Links, auf die verwiesen wird. Peanuts-Soft ist für die Inhalte, auf die per Link verwiesen wird, nicht verantwortlich. Peanuts-Soft haftet nicht für konkrete, mittelbare und unmittelbare Schäden oder Schäden, die durch fehlende Nutzungsmöglichkeiten, Datenverluste oder entgangene Gewinne – sei es aufgrund der Nichteinhaltung vertraglicher Verpflichtungen, durch Fahrlässigkeit oder eine andere unerlaubte Handlung – im Zusammenhang mit der Nutzung von Dokumenten oder Informationen bzw. der Erbringung von Dienstleistungen entstehen, die auf dieser Web Site zugänglich sind.
Datenschutz: Inhalt und Gestaltung der Internetseiten sind urheberrechtlich geschützt. Eine Vervielfältigung der Seiten oder deren Inhalte bedarf der vorherigen schriftlichen Zustimmung von Peanuts-Soft.


Locations of visitors to this page

Powered By

Domino BlogSphere
Version 3.0.2