23. januar 2004 - 15:48Der er
12 kommentarer og 1 løsning
VBA: uge+år til dato
På en formular kan der indtastes et 2 cifret ugenummre [uge] samt et 2 cifret årstal [aar]. Disse data modtages og behandles af noget VBA kode, som skal omregne f.eks. 02-04 til [fra]=05-01-2004 og [til]=09-01-2004.
Her er kaldet til funktionen: [fra] = UgeTilDato(([aar] Mod 100) * 100 + [uge]) [til] = DateAdd("d", 6, [fra])
Her er selve funktionen: Function UgeTilDato(uge As Integer) As Date Dim Dato As Date Dim ugenr As Integer
Dato = DateValue("1-1-" & uge \ 100) Dato = DateAdd("d", 2 - WeekDay(Dato), Dato) While DatePart("ww", Dato, vbMonday, vbFirstFourDays) <> 1 ugenr = DatePart("ww", Dato, vbMonday, vbFirstFourDays) Dato = DateAdd("ww", 1, Dato) Wend UgeTilDato = DateAdd("ww", (uge Mod 100) - 1, Dato) End Function
Problemet opstår bla. her i år 2004, da de returnerede værdier giver [fra]=10-01-2004 [til]=16-01-2004
Fejlen opstår igen i år 2008! (og i 2020, men da er programmet jo selvfølgelig "obsolete")
Hvordan skal funktionen omskrives, så jeg får noget brugbart for ALLE uge/år kombinationer?
I dette særtema ser vi på, hvordan cloud og AI bliver fundamentet for virksomhedernes digitale forretning, og hvordan de nye muligheder for automatisering og forretningsværdi kan udnyttes uden at miste overblik, sikkerhed og menneskelig kontrol.
puppetmaster>This functions expects the year to be formatted YYYY (2004)
Public Function YW2D(YYYY As Integer, WW As Integer, DayOfWeek As Integer) As Variant Dim v As Variant Dim lvar1Monday As Variant
'A couple of checks If YYYY < 1800 Or YYYY > 2100 Then YW2D = Null Exit Function End If If WW < 1 Or WW > 53 Then YW2D = Null Exit Function End If
'Find first Monday of Year lvar1Monday = DateSerial(YYYY, 1, 1) While Weekday(lvar1Monday) <> 2 '2 = vbMonday lvar1Monday = DateAdd("d", 1, lvar1Monday) Wend
'Calculate date v = DateSerial(YYYY, 1, (WW - 1) * 7 + Day(lvar1Monday)) If DayOfWeek > 0 And DayOfWeek < 8 Then v = DateAdd("d", DayOfWeek - 1, v) End If
'If the first Monday of the year is in week 2 then we must subtract a week If Val(Format(lvar1Monday, "ww", vbMonday, vbFirstFourDays)) = 2 Then v = DateAdd("d", -7, v) End If
Oh! It only returns one date. The last parameter gives the date for the day of the week, 1 being monday and 7 being sunday. So if you make two calls to th efunction first with 1 (monday) and the next with 5 (friday) you will hopefully get the two dates you want.
Tilladte BB-code-tags: [b]fed[/b] [i]kursiv[/i] [u]understreget[/u] Web- og emailadresser omdannes automatisk til links. Der sættes "nofollow" på alle links.
