Anders said:
Anders Ekebergh said:
Tomm said:
Jack D. said:
Tomm (Intersoft Norway) said:In commercial and industrial applications (delivery times, production plans,
etc.), especially in Europe, it is often required to refer to a week of a
year. Week 01 of a year is per definition the first week that has the
Thursday in this year, which is equivalent to the week that contains the
fourth day of January. In other words, the first week of a new year is the
week that has the majority of its days in the new year. Week 01 might also
contain days from the previous year and the week before week 01 of a year is
the last week (52 or 53) of the previous year even if it contains days from
the new year.
I have found endless weeknumber code samples but they have all failed to
meet the above mentioned requirements. Code sample below converts 3000+
dates to weeknumbers in a fraction of a second. So it's not always the
number of lines that determines efficiency. And I can guarantee the
accuracy. It's been in my library for more than ten years.
Jack:
If your code can stand the test:
datetoday = Now
For i = 0 to 3000
If "Some variation of: Format(DateAdd("d",7-Weekday([datetoday +
i]),[datetoday + i]),"ww")" <> GetWeekNum(datetoday + i, 1, 1)
Msgbox "Not Correct!"
End If
Next
then I will be happy to update my code library.
Tomm
Jack D. said:
Not sure there is a one-line solution to the problem:
Algorithm for Converting Gregorian Dates to ISO 8601 Week Date
(Y2K Compliant)
Rick McCarty, 1999
From: Gregorian Year-Month-Day
To: ISO YearNumber-WeekNumber-Weekday
ISO 8601 specifies that Week 01 of the year is the week containing
the first Thursday; Monday is Weekday 1, Sunday is Weekday 7;
WeekNumber requires two digits (W01, W02, etc.; "W" is optional)
Algorithm Conventions:
"/" = integer division, discard remainder (5/2 = 2)
"%" = modulus, keep only remainder (5%2 = 1)
"&" = concatenation ("W" & 12 = "W12")
"!=" = unequal (7 != 8 is true)
"+=" = add right value to left variable,
if F = 3, then (F += 4) yields F = 7
"-=" = subtract right value from left variable
1. Convert input to Y M D
Y = Year (full specification; input 98 = year 0098)
M = Month (1 through 12)
D = Day (1 through 31)
2. Find if Y is LeapYear
if (Y % 4 = 0 and Y % 100 != 0) or Y % 400 = 0
then
Y is LeapYear
else
Y is not LeapYear
3. Find if Y-1 is LeapYear
4. Find the DayOfYearNumber for Y M D
Mnth[1] = 0 Mnth[4] = 90 Mnth[7] = 181 Mnth[10] = 273
Mnth[2] = 31 Mnth[5] = 120 Mnth[8] = 212 Mnth[11] = 304
Mnth[3] = 59 Mnth[6] = 151 Mnth[9] = 243 Mnth[12] = 334
DayOfYearNumber = D + Mnth[M]
if Y is LeapYear and M > 2
then
DayOfYearNumber += 1
5. Find the Jan1Weekday for Y (Monday=1, Sunday=7)
YY = (Y-1) % 100
C = (Y-1) - YY
G = YY + YY/4
Jan1Weekday = 1 + (((((C / 100) % 4) x 5) + G) % 7)
6. Find the Weekday for Y M D
H = DayOfYearNumber + (Jan1Weekday - 1)
Weekday = 1 + ((H -1) % 7)
7. Find if Y M D falls in YearNumber Y-1, WeekNumber 52 or 53
if DayOfYearNumber <= (8-Jan1Weekday) and Jan1Weekday > 4
then
YearNumber = Y - 1
if Jan1Weekday = 5 or (Jan1Weekday = 6 and Y-1 is LeapYear)
then
WeekNumber = 53
else
WeekNumber = 52
else
YearNumber = Y
8. Find if Y M D falls in YearNumber Y+1, WeekNumber 1
if YearNumber = Y
then
if Y is LeapYear
then
I = 366
else
I = 365
if (I - DayOfYearNumber) < (4 - Weekday)
then
YearNumber = Y + 1
WeekNumber = 1
9. Find if Y M D falls in YearNumber Y, WeekNumber 1 through 53
if YearNumber = Y
then
J = DayOfYearNumber + (7 - Weekday) + (Jan1Weekday -1)
WeekNumber = J / 7
if Jan1Weekday > 4
WeekNumber -= 1
10. Output ISO Week Date:
if WeekNumber < 10
then
WeekNumber = "0" & WeekNumber (WeekNumber requires 2 digits)
YearNumber - WeekNumber - Weekday (Optional: "W" & WeekNumber)
Tomm (Intersoft Norway) said:In commercial and industrial applications (delivery times, production
plans, etc.), especially in Europe, it is often required to refer to a
week of a year. Week 01 of a year is per definition the first week that
has the Thursday in this year, which is equivalent to the week that
contains the fourth day of January. In other words, the first week of a
new year is the week that has the majority of its days in the new year.
Week 01 might also contain days from the previous year and the week
before week 01 of a year is the last week (52 or 53) of the previous
year even if it contains days from the new year.
I have found endless weeknumber code samples but they have all failed to
meet the above mentioned requirements. Code sample below converts 3000+
dates to weeknumbers in a fraction of a second. So it's not always the
number of lines that determines efficiency. And I can guarantee the
accuracy. It's been in my library for more than ten years.
Jack:
If your code can stand the test:
datetoday = Now
For i = 0 to 3000
If "Some variation of: Format(DateAdd("d",7-Weekday([datetoday +
i]),[datetoday + i]),"ww")" <> GetWeekNum(datetoday + i, 1, 1)
Msgbox "Not Correct!"
End If
Next
then I will be happy to update my code library.
Tomm
Jack D. said:
Jack D. said:Sure there is. The format function does this for you.
Format(date, "yy" & "'" & "ww", vbSunday, vbFirstFourDays)
Try it out.
-Jack
------------------------------------------
Not sure there is a one-line solution to the problem:
Algorithm for Converting Gregorian Dates to ISO 8601 Week Date
(Y2K Compliant)
Rick McCarty, 1999
From: Gregorian Year-Month-Day
To: ISO YearNumber-WeekNumber-Weekday
ISO 8601 specifies that Week 01 of the year is the week containing
the first Thursday; Monday is Weekday 1, Sunday is Weekday 7;
WeekNumber requires two digits (W01, W02, etc.; "W" is optional)
Algorithm Conventions:
"/" = integer division, discard remainder (5/2 = 2)
"%" = modulus, keep only remainder (5%2 = 1)
"&" = concatenation ("W" & 12 = "W12")
"!=" = unequal (7 != 8 is true)
"+=" = add right value to left variable,
if F = 3, then (F += 4) yields F = 7
"-=" = subtract right value from left variable
1. Convert input to Y M D
Y = Year (full specification; input 98 = year 0098)
M = Month (1 through 12)
D = Day (1 through 31)
2. Find if Y is LeapYear
if (Y % 4 = 0 and Y % 100 != 0) or Y % 400 = 0
then
Y is LeapYear
else
Y is not LeapYear
3. Find if Y-1 is LeapYear
4. Find the DayOfYearNumber for Y M D
Mnth[1] = 0 Mnth[4] = 90 Mnth[7] = 181 Mnth[10] = 273
Mnth[2] = 31 Mnth[5] = 120 Mnth[8] = 212 Mnth[11] = 304
Mnth[3] = 59 Mnth[6] = 151 Mnth[9] = 243 Mnth[12] = 334
DayOfYearNumber = D + Mnth[M]
if Y is LeapYear and M > 2
then
DayOfYearNumber += 1
5. Find the Jan1Weekday for Y (Monday=1, Sunday=7)
YY = (Y-1) % 100
C = (Y-1) - YY
G = YY + YY/4
Jan1Weekday = 1 + (((((C / 100) % 4) x 5) + G) % 7)
6. Find the Weekday for Y M D
H = DayOfYearNumber + (Jan1Weekday - 1)
Weekday = 1 + ((H -1) % 7)
7. Find if Y M D falls in YearNumber Y-1, WeekNumber 52 or 53
if DayOfYearNumber <= (8-Jan1Weekday) and Jan1Weekday > 4
then
YearNumber = Y - 1
if Jan1Weekday = 5 or (Jan1Weekday = 6 and Y-1 is LeapYear)
then
WeekNumber = 53
else
WeekNumber = 52
else
YearNumber = Y
8. Find if Y M D falls in YearNumber Y+1, WeekNumber 1
if YearNumber = Y
then
if Y is LeapYear
then
I = 366
else
I = 365
if (I - DayOfYearNumber) < (4 - Weekday)
then
YearNumber = Y + 1
WeekNumber = 1
9. Find if Y M D falls in YearNumber Y, WeekNumber 1 through 53
if YearNumber = Y
then
J = DayOfYearNumber + (7 - Weekday) + (Jan1Weekday -1)
WeekNumber = J / 7
if Jan1Weekday > 4
WeekNumber -= 1
10. Output ISO Week Date:
if WeekNumber < 10
then
WeekNumber = "0" & WeekNumber (WeekNumber requires 2 digits)
YearNumber - WeekNumber - Weekday (Optional: "W" & WeekNumber)
Tomm (Intersoft Norway) said:In commercial and industrial applications (delivery times, production
plans, etc.), especially in Europe, it is often required to refer to a
week of a year. Week 01 of a year is per definition the first week that
has the Thursday in this year, which is equivalent to the week that
contains the fourth day of January. In other words, the first week of a
new year is the week that has the majority of its days in the new year.
Week 01 might also contain days from the previous year and the week
before week 01 of a year is the last week (52 or 53) of the previous
year even if it contains days from the new year.
I have found endless weeknumber code samples but they have all failed to
meet the above mentioned requirements. Code sample below converts 3000+
dates to weeknumbers in a fraction of a second. So it's not always the
number of lines that determines efficiency. And I can guarantee the
accuracy. It's been in my library for more than ten years.
Jack:
If your code can stand the test:
datetoday = Now
For i = 0 to 3000
If "Some variation of: Format(DateAdd("d",7-Weekday([datetoday +
i]),[datetoday + i]),"ww")" <> GetWeekNum(datetoday + i, 1, 1)
Msgbox "Not Correct!"
End If
Next
then I will be happy to update my code library.
Tomm
"Jack D." <see sig for details> wrote in message
Tomm (Intersoft Norway) wrote:
message In Excel the formula WEEKNUM(serial_number, return_type)
can be used to convert a date (e.g 2003-10-24) into the
number of that week (e.g 43). This formula is not
avaliable in MS Project (as far as I know). How can it be
done instead?
If you're Swedish(?) you want European ISO-standard weeknumbers. Try
the following:
Sub TestWeekNum()
MsgBox GetWeekNum(CDate(DateSerial(2001, 12, 31)), 1, 1)
End Sub
Public Function GetWeekNum(ByVal idteDato As Date, ByVal
ilngFirstWeekOfYear As Integer, ByVal ilngFirstDayOfWeek As Integer,
Optional ByVal varFlag As Variant) As String
Dim dtCurr As Date, dtPrev As Date, dtNext As Date
Dim dtBaseDate As Date
Dim sWeekStr As String
Dim nYear As Integer, nYCurr As Integer, nYPrev As Integer
Dim nYNext As Integer, nYInput As Integer
Dim sYearStr As String
Dim nCase As Integer
If IsMissing(varFlag) Then
varFlag = 1
End If
If varFlag <> 2 Then
varFlag = 1
End If
dtCurr = dtWeekOneStart(Year(idteDato), _
ilngFirstWeekOfYear, _
ilngFirstDayOfWeek)
nYCurr = Year(dtCurr)
Select Case ilngFirstWeekOfYear
Case 0, 1
dtPrev = dtWeekOneStart(Year(idteDato) - 1, _
ilngFirstWeekOfYear, _
ilngFirstDayOfWeek)
nYPrev = Year(dtPrev)
dtNext = dtWeekOneStart(Year(idteDato) + 1, _
ilngFirstWeekOfYear, _
ilngFirstDayOfWeek)
nYNext = Year(dtNext)
nYInput = Year(idteDato)
If idteDato > dtCurr And idteDato < dtNext And _
idteDato > dtPrev And nYInput = nYCurr And _
nYInput <> nYNext And nYInput <> nYPrev Then
nCase = 1
ElseIf idteDato < dtCurr And idteDato < dtNext And _
idteDato > dtPrev And nYInput = nYCurr And _
nYInput <> nYNext And nYInput <> nYPrev Then
nCase = 2
ElseIf idteDato = dtCurr And idteDato < dtNext And _
idteDato > dtPrev And nYInput = nYCurr And _
nYInput <> nYNext And nYInput <> nYPrev Then
nCase = 3
ElseIf idteDato = dtCurr And idteDato < dtNext And _
idteDato > dtPrev And nYInput = nYCurr And _
nYInput = nYNext And nYInput <> nYPrev Then
nCase = 4
ElseIf idteDato > dtCurr And idteDato < dtNext And _
idteDato > dtPrev And nYInput = nYCurr And _
nYInput = nYNext And nYInput <> nYPrev Then
nCase = 5
ElseIf idteDato > dtCurr And idteDato = dtNext And _
idteDato > dtPrev And nYInput = nYCurr And _
nYInput = nYNext And nYInput <> nYPrev Then
nCase = 6
ElseIf idteDato > dtCurr And idteDato > dtNext And _
idteDato > dtPrev And nYInput = nYCurr And _
nYInput = nYNext And nYInput <> nYPrev Then
nCase = 7
ElseIf idteDato > dtCurr And idteDato < dtNext And _
idteDato > dtPrev And nYInput <> nYCurr And _
nYInput = nYNext And nYInput <> nYPrev Then
nCase = 8
ElseIf idteDato > dtCurr And idteDato = dtNext And _
idteDato > dtPrev And nYInput <> nYCurr And _
nYInput = nYNext And nYInput <> nYPrev Then
nCase = 9
ElseIf idteDato > dtCurr And idteDato > dtNext And _
idteDato > dtPrev And nYInput <> nYCurr And _
nYInput = nYNext And nYInput <> nYPrev Then
nCase = 10
ElseIf idteDato > dtCurr And idteDato < dtNext And _
idteDato > dtPrev And nYInput <> nYCurr And _
nYInput <> nYNext And nYInput <> nYPrev Then
nCase = 11
Else
nCase = 0
End If
Select Case nCase
Case 1
dtBaseDate = dtCurr
nYear = nYCurr
Case 2
dtBaseDate = dtPrev
If (nYCurr - nYPrev) > 1 Then
nYear = nYPrev + 1
Else
nYear = nYPrev
End If
Case 3
dtBaseDate = dtCurr
nYear = nYCurr
Case 4
dtBaseDate = dtCurr
nYear = nYCurr
Case 5
dtBaseDate = dtCurr
nYear = nYCurr
Case 6
dtBaseDate = idteDato
nYear = nYCurr + 1
Case 7
dtBaseDate = idteDato
nYear = nYCurr + 1
Case 8
dtBaseDate = dtCurr
nYear = nYCurr + 1
Case 9
dtBaseDate = idteDato
nYear = nYNext + 1
Case 10
dtBaseDate = idteDato
nYear = nYNext + 1
Case 11
dtBaseDate = dtCurr
nYear = nYCurr + 1
Case Else
dtBaseDate = 10000
nYear = 100
End Select
sYearStr = CStr(nYear)
sWeekStr = CStr(lCeiling((idteDato - dtBaseDate) / 6.99))
If Len(sWeekStr) = 1 Then sWeekStr = "0" & sWeekStr
If sWeekStr = "00" Then sWeekStr = "01"
If varFlag = 1 Then
sWeekStr = sYearStr & sWeekStr
Else
sWeekStr = Right(sYearStr, 2) & sWeekStr
End If
GetWeekNum = sWeekStr
Case 2
If idteDato < dtCurr Then
sYearStr = CStr(nYCurr)
sWeekStr = "00"
Else
sYearStr = CStr(nYCurr)
sWeekStr = CStr(lCeiling((idteDato - dtCurr) / 6.99))
If Len(sWeekStr) = 1 Then sWeekStr = "0" & sWeekStr
If sWeekStr = "00" Then sWeekStr = "01"
End If
If varFlag = 1 Then
sWeekStr = sYearStr & sWeekStr
Else
sWeekStr = Right(sYearStr, 2) & sWeekStr
End If
GetWeekNum = sWeekStr
End Select
End Function
Private Function dtWeekOneStart(nYear As Integer, ilngFirstWeekOfYear
As Integer, ilngFirstDayOfWeek As Integer) As Date
Dim dtTempDate As Date
Dim dtVarDate As Date
Dim nWeekday As Integer
Dim nWeekDay4 As Integer
Select Case ilngFirstWeekOfYear
Case 0
dtTempDate = DateSerial(nYear, 1, 1)
If Weekday(dtTempDate) <> (ilngFirstDayOfWeek + 1) Then
dtVarDate = dtTempDate
Do
dtVarDate = dtVarDate - 1
nWeekday = Weekday(dtVarDate)
Loop Until nWeekday = (ilngFirstDayOfWeek + 1)
dtTempDate = dtVarDate
End If
dtWeekOneStart = dtTempDate
Case 1
dtTempDate = DateSerial(nYear, 1, 1)
nWeekDay4 = (ilngFirstDayOfWeek + 1) + 3
dtVarDate = dtTempDate
Do
nWeekday = Weekday(dtVarDate)
If nWeekday = nWeekDay4 Then
dtTempDate = dtVarDate - 3
End If
dtVarDate = dtVarDate + 1
Loop Until nWeekday = nWeekDay4
dtWeekOneStart = dtTempDate
Case 2
dtTempDate = DateSerial(nYear, 1, 1)
If Weekday(dtTempDate) <> (ilngFirstDayOfWeek + 1) Then
dtVarDate = dtTempDate
Do
dtVarDate = dtVarDate + 1
nWeekday = Weekday(dtVarDate)
Loop Until nWeekday = (ilngFirstDayOfWeek + 1)
dtTempDate = dtVarDate
End If
dtWeekOneStart = dtTempDate
End Select
End Function
Private Function lCeiling(dValue As Double) As Long
Dim dValue1 As Double
Dim dValue2 As Double
dValue1 = dValue
dValue2 = Int(dValue)
If dValue1 = dValue2 Then
lCeiling = CLng(dValue)
Else
lCeiling = CLng(Int(dValue + 1))
End If
End Function
Wow!
I used to have some code like that, but it turned out I could boil it
down to a single format statement.
I don't know the European ISO spec, but it seems that you could do it
more simply.
This is the formula I use in a customized text field to show the
workweek that a task will finish.
Format(DateAdd("d",7-Weekday([Finish]),[Finish]),"ww")
Add an iff statement or two and it should work for every case.
--
Please try to keep replies in this group. I do check e-mail, but only
infrequently. For Macros and other things check
http://masamiki.com/project
-Jack Dahlgren, Project MVP
email: J -at- eM Vee Pee S dot COM
+++++++++++++++++++
--
Please try to keep replies in this group. I do check e-mail, but only
infrequently. For Macros and other things check http://masamiki.com/project
-Jack Dahlgren, Project MVP
email: J -at- eM Vee Pee S dot COM
+++++++++++++++++++
I was aware Outlook had the argument vbFirstFourDays which results in the
European weeknumbers. I now realize it's part of VBA. And I had to check
it out. Maybe I did that earlier on but don't remember. Anyways, it's not
returning correct results.
MsgBox Format(DateSerial(2000, 1, 1), "yy" & "'" & "ww", vbMonday,
vbFirstFourDays)
In Europe Weeks start on monday. Jan 1 2000 returns 00'52 using Format -
meaning week 52 in year 2000. This is incorrect.
I guess Round and Weeknumber functions are the two most annoying functions
at least for a european in VBA.
Tomm
Jack D. said:Sure there is. The format function does this for you.
Format(date, "yy" & "'" & "ww", vbSunday, vbFirstFourDays)
Try it out.
-Jack
------------------------------------------
Not sure there is a one-line solution to the problem:
Algorithm for Converting Gregorian Dates to ISO 8601 Week Date
(Y2K Compliant)
Rick McCarty, 1999
From: Gregorian Year-Month-Day
To: ISO YearNumber-WeekNumber-Weekday
ISO 8601 specifies that Week 01 of the year is the week containing
the first Thursday; Monday is Weekday 1, Sunday is Weekday 7;
WeekNumber requires two digits (W01, W02, etc.; "W" is optional)
Algorithm Conventions:
"/" = integer division, discard remainder (5/2 = 2)
"%" = modulus, keep only remainder (5%2 = 1)
"&" = concatenation ("W" & 12 = "W12")
"!=" = unequal (7 != 8 is true)
"+=" = add right value to left variable,
if F = 3, then (F += 4) yields F = 7
"-=" = subtract right value from left variable
1. Convert input to Y M D
Y = Year (full specification; input 98 = year 0098)
M = Month (1 through 12)
D = Day (1 through 31)
2. Find if Y is LeapYear
if (Y % 4 = 0 and Y % 100 != 0) or Y % 400 = 0
then
Y is LeapYear
else
Y is not LeapYear
3. Find if Y-1 is LeapYear
4. Find the DayOfYearNumber for Y M D
Mnth[1] = 0 Mnth[4] = 90 Mnth[7] = 181 Mnth[10] = 273
Mnth[2] = 31 Mnth[5] = 120 Mnth[8] = 212 Mnth[11] = 304
Mnth[3] = 59 Mnth[6] = 151 Mnth[9] = 243 Mnth[12] = 334
DayOfYearNumber = D + Mnth[M]
if Y is LeapYear and M > 2
then
DayOfYearNumber += 1
5. Find the Jan1Weekday for Y (Monday=1, Sunday=7)
YY = (Y-1) % 100
C = (Y-1) - YY
G = YY + YY/4
Jan1Weekday = 1 + (((((C / 100) % 4) x 5) + G) % 7)
6. Find the Weekday for Y M D
H = DayOfYearNumber + (Jan1Weekday - 1)
Weekday = 1 + ((H -1) % 7)
7. Find if Y M D falls in YearNumber Y-1, WeekNumber 52 or 53
if DayOfYearNumber <= (8-Jan1Weekday) and Jan1Weekday > 4
then
YearNumber = Y - 1
if Jan1Weekday = 5 or (Jan1Weekday = 6 and Y-1 is LeapYear)
then
WeekNumber = 53
else
WeekNumber = 52
else
YearNumber = Y
8. Find if Y M D falls in YearNumber Y+1, WeekNumber 1
if YearNumber = Y
then
if Y is LeapYear
then
I = 366
else
I = 365
if (I - DayOfYearNumber) < (4 - Weekday)
then
YearNumber = Y + 1
WeekNumber = 1
9. Find if Y M D falls in YearNumber Y, WeekNumber 1 through 53
if YearNumber = Y
then
J = DayOfYearNumber + (7 - Weekday) + (Jan1Weekday -1)
WeekNumber = J / 7
if Jan1Weekday > 4
WeekNumber -= 1
10. Output ISO Week Date:
if WeekNumber < 10
then
WeekNumber = "0" & WeekNumber (WeekNumber requires 2 digits)
YearNumber - WeekNumber - Weekday (Optional: "W" & WeekNumber)
"Tomm (Intersoft Norway)" <msnews.microsoft.com> wrote in message
In commercial and industrial applications (delivery times, production
plans, etc.), especially in Europe, it is often required to refer to a
week of a year. Week 01 of a year is per definition the first week that
has the Thursday in this year, which is equivalent to the week that
contains the fourth day of January. In other words, the first week of a
new year is the week that has the majority of its days in the new year.
Week 01 might also contain days from the previous year and the week
before week 01 of a year is the last week (52 or 53) of the previous
year even if it contains days from the new year.
I have found endless weeknumber code samples but they have all failed
to meet the above mentioned requirements. Code sample below converts
3000+ dates to weeknumbers in a fraction of a second. So it's not
always the number of lines that determines efficiency. And I can
guarantee the accuracy. It's been in my library for more than ten
years.
Jack:
If your code can stand the test:
datetoday = Now
For i = 0 to 3000
If "Some variation of: Format(DateAdd("d",7-Weekday([datetoday +
i]),[datetoday + i]),"ww")" <> GetWeekNum(datetoday + i, 1, 1)
Msgbox "Not Correct!"
End If
Next
then I will be happy to update my code library.
Tomm
"Jack D." <see sig for details> wrote in message
Tomm (Intersoft Norway) wrote:
message In Excel the formula WEEKNUM(serial_number, return_type)
can be used to convert a date (e.g 2003-10-24) into the
number of that week (e.g 43). This formula is not
avaliable in MS Project (as far as I know). How can it be
done instead?
If you're Swedish(?) you want European ISO-standard weeknumbers. Try
the following:
Sub TestWeekNum()
MsgBox GetWeekNum(CDate(DateSerial(2001, 12, 31)), 1, 1)
End Sub
Public Function GetWeekNum(ByVal idteDato As Date, ByVal
ilngFirstWeekOfYear As Integer, ByVal ilngFirstDayOfWeek As Integer,
Optional ByVal varFlag As Variant) As String
Dim dtCurr As Date, dtPrev As Date, dtNext As Date
Dim dtBaseDate As Date
Dim sWeekStr As String
Dim nYear As Integer, nYCurr As Integer, nYPrev As Integer
Dim nYNext As Integer, nYInput As Integer
Dim sYearStr As String
Dim nCase As Integer
If IsMissing(varFlag) Then
varFlag = 1
End If
If varFlag <> 2 Then
varFlag = 1
End If
dtCurr = dtWeekOneStart(Year(idteDato), _
ilngFirstWeekOfYear, _
ilngFirstDayOfWeek)
nYCurr = Year(dtCurr)
Select Case ilngFirstWeekOfYear
Case 0, 1
dtPrev = dtWeekOneStart(Year(idteDato) - 1, _
ilngFirstWeekOfYear, _
ilngFirstDayOfWeek)
nYPrev = Year(dtPrev)
dtNext = dtWeekOneStart(Year(idteDato) + 1, _
ilngFirstWeekOfYear, _
ilngFirstDayOfWeek)
nYNext = Year(dtNext)
nYInput = Year(idteDato)
If idteDato > dtCurr And idteDato < dtNext And _
idteDato > dtPrev And nYInput = nYCurr And _
nYInput <> nYNext And nYInput <> nYPrev Then
nCase = 1
ElseIf idteDato < dtCurr And idteDato < dtNext And _
idteDato > dtPrev And nYInput = nYCurr And _
nYInput <> nYNext And nYInput <> nYPrev Then
nCase = 2
ElseIf idteDato = dtCurr And idteDato < dtNext And _
idteDato > dtPrev And nYInput = nYCurr And _
nYInput <> nYNext And nYInput <> nYPrev Then
nCase = 3
ElseIf idteDato = dtCurr And idteDato < dtNext And _
idteDato > dtPrev And nYInput = nYCurr And _
nYInput = nYNext And nYInput <> nYPrev Then
nCase = 4
ElseIf idteDato > dtCurr And idteDato < dtNext And _
idteDato > dtPrev And nYInput = nYCurr And _
nYInput = nYNext And nYInput <> nYPrev Then
nCase = 5
ElseIf idteDato > dtCurr And idteDato = dtNext And _
idteDato > dtPrev And nYInput = nYCurr And _
nYInput = nYNext And nYInput <> nYPrev Then
nCase = 6
ElseIf idteDato > dtCurr And idteDato > dtNext And _
idteDato > dtPrev And nYInput = nYCurr And _
nYInput = nYNext And nYInput <> nYPrev Then
nCase = 7
ElseIf idteDato > dtCurr And idteDato < dtNext And _
idteDato > dtPrev And nYInput <> nYCurr And _
nYInput = nYNext And nYInput <> nYPrev Then
nCase = 8
ElseIf idteDato > dtCurr And idteDato = dtNext And _
idteDato > dtPrev And nYInput <> nYCurr And _
nYInput = nYNext And nYInput <> nYPrev Then
nCase = 9
ElseIf idteDato > dtCurr And idteDato > dtNext And _
idteDato > dtPrev And nYInput <> nYCurr And _
nYInput = nYNext And nYInput <> nYPrev Then
nCase = 10
ElseIf idteDato > dtCurr And idteDato < dtNext And _
idteDato > dtPrev And nYInput <> nYCurr And _
nYInput <> nYNext And nYInput <> nYPrev Then
nCase = 11
Else
nCase = 0
End If
Select Case nCase
Case 1
dtBaseDate = dtCurr
nYear = nYCurr
Case 2
dtBaseDate = dtPrev
If (nYCurr - nYPrev) > 1 Then
nYear = nYPrev + 1
Else
nYear = nYPrev
End If
Case 3
dtBaseDate = dtCurr
nYear = nYCurr
Case 4
dtBaseDate = dtCurr
nYear = nYCurr
Case 5
dtBaseDate = dtCurr
nYear = nYCurr
Case 6
dtBaseDate = idteDato
nYear = nYCurr + 1
Case 7
dtBaseDate = idteDato
nYear = nYCurr + 1
Case 8
dtBaseDate = dtCurr
nYear = nYCurr + 1
Case 9
dtBaseDate = idteDato
nYear = nYNext + 1
Case 10
dtBaseDate = idteDato
nYear = nYNext + 1
Case 11
dtBaseDate = dtCurr
nYear = nYCurr + 1
Case Else
dtBaseDate = 10000
nYear = 100
End Select
sYearStr = CStr(nYear)
sWeekStr = CStr(lCeiling((idteDato - dtBaseDate) / 6.99))
If Len(sWeekStr) = 1 Then sWeekStr = "0" & sWeekStr
If sWeekStr = "00" Then sWeekStr = "01"
If varFlag = 1 Then
sWeekStr = sYearStr & sWeekStr
Else
sWeekStr = Right(sYearStr, 2) & sWeekStr
End If
GetWeekNum = sWeekStr
Case 2
If idteDato < dtCurr Then
sYearStr = CStr(nYCurr)
sWeekStr = "00"
Else
sYearStr = CStr(nYCurr)
sWeekStr = CStr(lCeiling((idteDato - dtCurr) / 6.99))
If Len(sWeekStr) = 1 Then sWeekStr = "0" & sWeekStr
If sWeekStr = "00" Then sWeekStr = "01"
End If
If varFlag = 1 Then
sWeekStr = sYearStr & sWeekStr
Else
sWeekStr = Right(sYearStr, 2) & sWeekStr
End If
GetWeekNum = sWeekStr
End Select
End Function
Private Function dtWeekOneStart(nYear As Integer, ilngFirstWeekOfYear
As Integer, ilngFirstDayOfWeek As Integer) As Date
Dim dtTempDate As Date
Dim dtVarDate As Date
Dim nWeekday As Integer
Dim nWeekDay4 As Integer
Select Case ilngFirstWeekOfYear
Case 0
dtTempDate = DateSerial(nYear, 1, 1)
If Weekday(dtTempDate) <> (ilngFirstDayOfWeek + 1) Then
dtVarDate = dtTempDate
Do
dtVarDate = dtVarDate - 1
nWeekday = Weekday(dtVarDate)
Loop Until nWeekday = (ilngFirstDayOfWeek + 1)
dtTempDate = dtVarDate
End If
dtWeekOneStart = dtTempDate
Case 1
dtTempDate = DateSerial(nYear, 1, 1)
nWeekDay4 = (ilngFirstDayOfWeek + 1) + 3
dtVarDate = dtTempDate
Do
nWeekday = Weekday(dtVarDate)
If nWeekday = nWeekDay4 Then
dtTempDate = dtVarDate - 3
End If
dtVarDate = dtVarDate + 1
Loop Until nWeekday = nWeekDay4
dtWeekOneStart = dtTempDate
Case 2
dtTempDate = DateSerial(nYear, 1, 1)
If Weekday(dtTempDate) <> (ilngFirstDayOfWeek + 1) Then
dtVarDate = dtTempDate
Do
dtVarDate = dtVarDate + 1
nWeekday = Weekday(dtVarDate)
Loop Until nWeekday = (ilngFirstDayOfWeek + 1)
dtTempDate = dtVarDate
End If
dtWeekOneStart = dtTempDate
End Select
End Function
Private Function lCeiling(dValue As Double) As Long
Dim dValue1 As Double
Dim dValue2 As Double
dValue1 = dValue
dValue2 = Int(dValue)
If dValue1 = dValue2 Then
lCeiling = CLng(dValue)
Else
lCeiling = CLng(Int(dValue + 1))
End If
End Function
Wow!
I used to have some code like that, but it turned out I could boil it
down to a single format statement.
I don't know the European ISO spec, but it seems that you could do it
more simply.
This is the formula I use in a customized text field to show the
workweek that a task will finish.
Format(DateAdd("d",7-Weekday([Finish]),[Finish]),"ww")
Add an iff statement or two and it should work for every case.
--
Please try to keep replies in this group. I do check e-mail, but only
infrequently. For Macros and other things check
http://masamiki.com/project
-Jack Dahlgren, Project MVP
email: J -at- eM Vee Pee S dot COM
+++++++++++++++++++
--
Please try to keep replies in this group. I do check e-mail, but only
infrequently. For Macros and other things check
http://masamiki.com/project
-Jack Dahlgren, Project MVP
email: J -at- eM Vee Pee S dot COM
+++++++++++++++++++
Anders said: