VGnet.dk - Dato og tid

Koden anvendes helt på eget ansvar!

Indhold:

Påskedag
Rigtigt ugenummer
År og ugenummer
Ugens første eller sidste dato
Månedens første eller sidste dato
En dato i en bestemt uge
Sommertids begyndelse og slut
Antal ugedage i en måned
Er året skudår?
Fra år-uge til år-måned
Oversæt engelske datoer
Er dagen en helligdag eller en bro-helligdag?

Påskedag

Koden herunder til at finde påskedag i et givent år er angiveligt lavet af en bruger ved navn "nuab" på http://www.eksperten.dk/spm/366107. Herunder gengives hans kode omskrevet til VBA. Omskrivningen til VBA er mit originale bidrag.

Function Paaskedag(aar As Integer) As Date
' (C) Copyright Lars Vangsgaard og "nuab"
' Påskedag et givent år
' Påskedag et givent år
' Lavet af "nuab" og offentliggjort på http://www.eksperten.dk/spm/366107.
' Fundet ved Google-søgning på ordene "påskedag kalender".
' Kausalitet:
'   a b c d e f g h i k l m n p PD
'år x x x                       x
'a                x       x
'b        x x x x x
'c                  x x
'd                x
'e                      x
'f              x
'g                x
'h                      x x x x
'i                      x
'k                      x
'l                        x
'm                          x x
'n                              x
'p                              x
  Dim a, b, c, d, e, f, g, h, i, j, k, l, m, n, o, p
  a = aar Mod 19
  b = aar \ 100
  c = aar Mod 100
  d = b \ 4
  e = b Mod 4
  f = (b + 8) \ 25
  g = (b - f + 1) \ 3
  h = (19 * a + b - d - g + 15) Mod 30
  i = c \ 4
  k = c Mod 4
  l = (32 + (2 * e) + (2 * i) - h - k) Mod 7
  m = (a + (11 * h) + (22 * l)) \ 451
  n = ((h + l) - (7 * m) + 114) \ 31
  p = ((h + l) - (7 * m) + 114) Mod 31
  Paaskedag = DateSerial(aar, n, p + 1)
End Function

Rigtigt ugenummer

Function RigtigUge(Dato As Date) As Integer
' (C) Copyright Lars Vangsgaard
' Korrigerer VBAs ugenummertal
' Hverken Excel eller VBA kan håndtere ugenumre korrekt.
' VBA regner dog mindst forkert og behøver kun en mindre korrektion.
  Dim h As Integer
  h = DatePart("ww", Dato, vbMonday, vbFirstFourDays)
' VBAs næsten korrekte udspil
  If h = 53 And _
    DatePart("w", Dato, vbMonday, vbFirstFourDays) = 1 And _
    DatePart("ww", Dato + 1, vbMonday, vbFirstFourDays) = 1 Then
' Hvis mandag i uge 53 og tirsdag er uge 1, så korriger
    h = 1
  End If
  RigtigUge = h
End Function

År og ugenummer

I forlængelse af funktionen "RigtigUge" giver denne funktion en tekststreng med ugenumret og det tilhørende år. Året er ikke nødvendigvis datoens årstal, hvis datoen er sidst i december eller først i januar. Eksempel: 31-12-2002 tilhørte "2003-01", uge 1 i 2003.

Function AarOgUge(Dato As Date) As String
' (C) Copyright Lars Vangsgaard
' Ugenummer og det årstal ugen hører til, på formen åååå-uu
  Dim aar As Integer, mnd As Integer, uge As Integer
  aar = DatePart("yyyy", Dato, vbMonday, vbFirstFourDays)
  mnd = DatePart("m", Dato, vbMonday, vbFirstFourDays)
  uge = RigtigUge(Dato)
  If uge <= 6 And mnd = 12 Then aar = aar + 1
  If uge >= 46 And mnd = 1 Then aar = aar - 1
  AarOgUge = Format(aar, "0000") & "-" & Format(uge, "00")
End Function

Ugens første eller sidste dato

Function UgeBeg(Dato As Date) As Date
' (C) Copyright Lars Vangsgaard
' Giver datoen for mandagen før en dato
  UgeBeg = Dato - DatePart("w", Dato, vbMonday, vbFirstFourDays) + 1
End Function

Function UgeSlut(Dato As Date) As Date
' (C) Copyright Lars Vangsgaard
' Giver datoen for søndagen efter en dato
  UgeSlut = Dato - DatePart("w", Dato, vbMonday, vbFirstFourDays) + 7
End Function

Månedens første eller sidste dato

Function MndBeg(Dato as Date) as Date
' (C) Copyright Lars Vangsgaard
' Giver datoen for månedens første dag
  MndBeg = DateSerial(Year(Dato), Month(Dato), 1)
End Function

Function MndSlut(Dato as Date) as Date
' (C) Copyright Lars Vangsgaard
' Giver datoen for månedens sidste dag
  If Month(Dato)<>12 Then
    MndSlut = DateSerial(Year(Dato), Month(Dato) + 1, 1) - 1
  Else
    MndSlut = DateSerial(Year(Dato) + 1, 1, 1) - 1
  End If
End Function

En dato i en bestemt uge

Function DatoIUge(aar As Integer, uge As Integer, Optional Ugedag) As Date
' (C) Copyright Lars Vangsgaard
' Udregner den dato, der svarer til en dag i en bestemt uge.
' Standarddagen er mandag.
  Dim FiksDato As Date
  If IsMissing(Ugedag) Then Ugedag = 1
  If Ugedag > 7 Then Ugedag = 7 ' Kun ugedage 1 til 7
  If Ugedag < 1 Then Ugedag = 1
  ' Der arbejdes ud fra en referencedato, som er mandagen i ugen med 15. januar.
  FiksDato = DateSerial(aar, 1, 15) - DatePart("w", DateSerial(aar, 1, 15), vbMonday, vbFirstFourDays) + 1
  DatoIUge = FiksDato + 7 * (uge - RigtigUge(FiksDato)) + Ugedag - 1
End Function

Sommertids begyndelse og slut

Beregner forårets eller efterårets sommertidsdato.

Hvis funktionen kun skal bruges til Excel (regneark), kan datoerne med fordel beregnes som

=DATO(A1;4;1)-UGEDAG(DATO(A1;4;1)-1;1)
og
=DATO(A1;11;1)-UGEDAG(DATO(A1;11;1)-1;1)

hvor "A1" skal erstattes med cellen med årstallet.

Function Sommertidsdato(aar As Integer, BegSlut As Integer) As Date
' (C) Copyright Lars Vangsgaard
' Beregner sommertidsdatoerne ud fra året.
' Sommertid antages at være sidste søndag i hhv. marts og oktober (time 3).
' Syntaks: Sommertid(År,1|2), 1 for forårsdagen, 2 (eller andet) for efterårsdagen.
  Dim Dato As Date
  If BegSlut = 1 Then
    Dato = DateSerial(aar, 4, 1)
    Sommertidsdato = Dato - DatePart("w", Dato, vbMonday)
  Else
    Dato = DateSerial(aar, 11, 1)
    Sommertidsdato = Dato - DatePart("w", Dato, vbMonday)
  End If
End Function

Antal ugedage i en måned

Function AntalUgedage(ugd As Integer, aar As Integer, mnd As Integer)
' (C) Copyright Lars Vangsgaard
' Beregner antal af en bestemt slags ugedage i en måned.
' Grundprincip: En måned består af 4 hele uger plus 0-3 ekstra dage.
  Dim dag As Date, Ugedag As Integer, denne As Date, neste As Date
  Dim antugd(1 To 7) As Integer
  If ((mnd < 1) Or (mnd > 12)) Then Exit Function
  denne = DateSerial(aar, mnd, 1) ' Den første i måneden
  If mnd < 12 Then
    neste = DateSerial(aar, mnd + 1, 1)
  Else
    neste = DateSerial(aar + 1, 1, 1)
  End If
  For dag = denne To neste - 1
    Ugedag = DatePart("w", dag, vbMonday)
    antugd(Ugedag) = antugd(Ugedag) + 1
  Next dag
  AntalUgedage = antugd(ugd)
End Function

Er året skudår?

Function ErSkudaar(aar As Integer) As Boolean
' (C) Copyright Lars Vangsgaard
  ErSkudaar = False
  If ((aar Mod 4) = 0 _
    And (((aar Mod 100) <> 0) _
      Or ((aar Mod 400) = 0))) _
  Then ErSkudaar = True
End Function

En bestemt uges mandag

Function UgensMandag(aar As Integer, uge As Integer) As Date
' (C) Copyright Lars Vangsgaard
  Dim u As Integer, d As Date
  u = DatePart("w", DateSerial(aar, 1, 1), vbMonday, vbFirstFourDays)
  If u <= 4 Then
    d = (8 - u) + DateSerial(aar, 1, 1)
  Else
    d = (15 - u) + DateSerial(aar, 1, 1)
  End If
  UgensMandag = d + 7 * (uge - 2)
End Function

Fra år-uge til år-måned

"Firedagesprincippet" går ud på, at en uge tilregnes den måned, hvor mindst fire af dens dage ligger.

Version 1 (kræver funktionen "UgensMandag" ovenfor):

Function AUtAM(uaar As Integer, uge As Integer)
' (C) Copyright Lars Vangsgaard
' Omregner fra År-Uge til År-Md efter firedagesprincippet
  Dim tors As Date, aar As Integer, mnd As Integer
  tors = UgensMandag(uaar, uge) + 3
  aar = DatePart("yyyy", tors, vbMonday, vbFirstFourDays)
  mnd = DatePart("m", tors, vbMonday, vbFirstFourDays)
  AUtAM = Format(aar, "0000") & "-" & Format(mnd, "00")
End Function

Version 2 (selvstående):

Function UgeTilMåned(aar As Integer, uge As Integer) As String
' (C) Copyright Lars Vangsgaard
' Omregner fra År-Uge til År-Md efter firedagesprincippet
  Dim h As Date
  h = DatoIUge(aar, uge, 1)
  If DatePart("d", h + 7) >= 5 Then
    UgeTilMåned = Format(DatePart("yyyy", h + 7), "0000") & "-" & Format(DatePart("m", h + 7), "00")
  Else
    UgeTilMåned = Format(DatePart("yyyy", h), "0000") & "-" & Format(DatePart("m", h), "00")
  End If
End Function

Oversæt engelske datoer

Function TydEngelskMåned(ByVal S As String) As Integer
' (C) Copyright Lars Vangsgaard
' Månedens nummer
  Dim h
  Select Case S
    Case "January", "Jan": h = 1
    Case "February", "Feb": h = 2
    Case "March", "Mar": h = 3
    Case "April", "Apr": h = 4
    Case "May": h = 5
    Case "June", "Jun": h = 6
    Case "July", "Jul": h = 7
    Case "August", "Aug": h = 8
    Case "September", "Sep": h = 9
    Case "October", "Oct": h = 10
    Case "November", "Nov": h = 11
    Case "December", "Dec": h = 12
    Case Else: h = 0
  End Select
  TydEngelskMåned = h
End Function

Function TydEngelskDato(ByVal S As String) As Date
' (C) Copyright Lars Vangsgaard
' Oversætter en dato på formen 22nd March 2005
  Dim d, mh, m, a
  d = Left(S, InStr(1, S, " ") - 3)
  mh = Right(S, Len(S) - InStr(1, S, " "))
  mh = Left(mh, Len(mh) - 5)
  m = TydEngelskMåned(mh)
  a = Right(S, 4)
  TydEngelskDato = DateSerial(a, m, d)
End Function

Er dagen en helligdag eller en bro-helligdag?

Der beregnes efter forskellige nærtliggende landes skikke. En "bro-helligdag" er en arbejdsdag klemt inde mellem to fridage, f.eks. Kristi Himmelfarts Dag, eller 6. juni hvis Grundlovsdag er en torsdag. Funktionens resultater bør kontrolleres i forhold til anvendelsesformålet.

Kræver funktionen "Paaskedag" ovenfor.

Function ErHelligdag(Dato As Date, Optional Land, Optional Bro, Optional Soendag, Optional Loerdag) As Boolean
' (C) Copyright Lars Vangsgaard
' Giver sand/falsk for om en dato er en helligdag.
' Kan også klare "bridge-helligdage", søndage og lørdage (sat til falsk hvis udeladt)
  Dim aar As Integer, mnd As Integer, dag As Integer, ugd As Integer
  Dim paaskedato As Date, fokusdato As Date
  If IsMissing(Land) Then Land = "DK"
  If IsMissing(Bro) Then Bro = False
  If IsMissing(Soendag) Then Soendag = False
  If IsMissing(Loerdag) Then Loerdag = False
  ErHelligdag = False
  aar = DatePart("yyyy", Dato, vbMonday, vbFirstFourDays)
  mnd = DatePart("m", Dato, vbMonday, vbFirstFourDays)
  dag = DatePart("d", Dato, vbMonday, vbFirstFourDays)
  ugd = DatePart("w", Dato, vbMonday, vbFirstFourDays)
  paaskedato = Paaskedag(aar)
  If mnd = 1 Then
    If dag = 1 Then ErHelligdag = True ' Nytårsdag
    If dag = 2 And ugd = 5 And Bro Then ErHelligdag = True
  End If
  If mnd = 12 Then
    If dag = 23 And ugd = 1 And Bro Then ErHelligdag = True
    If dag = 24 Then ErHelligdag = True
    If dag = 25 Then ErHelligdag = True
    If dag = 26 Then ErHelligdag = True
    If dag = 27 And ugd = 5 And Bro Then ErHelligdag = True
    If dag = 30 And ugd = 1 And Bro Then ErHelligdag = True
    If dag = 31 Then ErHelligdag = True
  End If
  Select Case (Dato - paaskedato)
    Case -3: ErHelligdag = True ' Skærtorsdag
    Case -2: ErHelligdag = True ' Langfredag
    Case 0: ErHelligdag = True  ' Påskedag
    Case 1: ErHelligdag = True  ' 2. Påskedag
    'Case 26: ErHelligdag = True ' Store Bededag
    Case 39: ErHelligdag = True ' Kristi Himmelfarts dag
    Case 40: If Bro Then ErHelligdag = True
    Case 49: ErHelligdag = True ' Pinsedag
    Case 50: ErHelligdag = True ' 2. Pinsedag
  End Select
  If ugd = 7 And Soendag Then ErHelligdag = True
  If ugd = 6 And Loerdag Then ErHelligdag = True
  If Land = "DK" Then
    If mnd = 6 Then
      If dag = 4 And ugd = 1 And Bro Then ErHelligdag = True
      If dag = 5 Then ErHelligdag = True ' Grundlovsdag
      If dag = 6 And ugd = 5 And Bro Then ErHelligdag = True
    End If
    If Dato - paaskedato = 26 Then ErHelligdag = True ' Store Bededag
  ElseIf Land = "NO" Then
    If mnd = 5 Then
      If dag = 16 And ugd = 1 And Bro Then ErHelligdag = True
      If dag = 17 Then ErHelligdag = True ' 17. maj
      If dag = 18 And ugd = 5 And Bro Then ErHelligdag = True
    End If
    If Dato - paaskedato = -4 Then ErHelligdag = True ' Askeonsdag
  ElseIf Land = "SE" Then
    If mnd = 1 Then
      If dag = 5 And ugd = 1 And Bro Then ErHelligdag = True
      If dag = 6 Then ErHelligdag = True ' Hellig tre konger
      If dag = 7 And ugd = 5 And Bro Then ErHelligdag = True
    End If
    If mnd = 6 Then
      If dag = 5 And ugd = 1 And Bro Then ErHelligdag = True
      If dag = 6 Then ErHelligdag = True ' Nationaldag
      If dag = 7 And ugd = 5 And Bro Then ErHelligdag = True
    End If
    ' Valborgsaften udgår af betragtning, fordi dagen efter er 1. maj.
    ' Midsommeraften/Skt. Hans
    fokusdato = DateSerial(aar, 6, 19) _
       + (12 - DatePart("w", DateSerial(aar, 6, 19), vbMonday, vbFirstFourDays)) Mod 7
    If Dato = fokusdato Then ErHelligdag = True
    ' Allehelgen: 30/10+(12-ugedag(30/10)) mod 7
    fokusdato = DateSerial(aar, 10, 30) _
       + (12 - DatePart("w", DateSerial(aar, 10, 30), vbMonday, vbFirstFourDays)) Mod 7
    If Dato = fokusdato Then ErHelligdag = True
  ElseIf Land = "FI" Then
    If mnd = 1 Then
      If dag = 5 And ugd = 1 And Bro Then ErHelligdag = True
      If dag = 6 Then ErHelligdag = True ' Hellig tre konger
      If dag = 7 And ugd = 5 And Bro Then ErHelligdag = True
    End If
    ' Valborgsaften udgår af betragtning, fordi dagen efter er 1. maj.
    ' Midsommeraften/Skt. Hans
    fokusdato = DateSerial(aar, 6, 19) _
       + (12 - DatePart("w", DateSerial(aar, 6, 19), vbMonday, vbFirstFourDays)) Mod 7
    If Dato = fokusdato Then ErHelligdag = True
    ' Allehelgen: 30/10+(12-ugedag(30/10)) mod 7
    fokusdato = DateSerial(aar, 10, 30) _
       + (12 - DatePart("w", DateSerial(aar, 10, 30), vbMonday, vbFirstFourDays)) Mod 7
    If Dato = fokusdato Then ErHelligdag = True
    If mnd = 12 Then
      If dag = 5 And ugd = 1 And Bro Then ErHelligdag = True
      If dag = 6 Then ErHelligdag = True ' Uafhængighedsdag
      If dag = 7 And ugd = 5 And Bro Then ErHelligdag = True
    End If
  ElseIf Land = "DE" Then
    If mnd = 1 Then
      If dag = 5 And ugd = 1 And Bro Then ErHelligdag = True
      If dag = 6 Then ErHelligdag = True ' Hellig tre konger
      If dag = 7 And ugd = 5 And Bro Then ErHelligdag = True
    End If
    ' Muttertag, 2. søndag i maj, er ikke medtaget
    If mnd = 8 Then
      If dag = 14 And ugd = 1 And Bro Then ErHelligdag = True
      If dag = 15 Then ErHelligdag = True ' Mariæ himmelfart
      If dag = 16 And ugd = 5 And Bro Then ErHelligdag = True
    End If
    If mnd = 10 Then
      If dag = 2 And ugd = 1 And Bro Then ErHelligdag = True
      If dag = 3 Then ErHelligdag = True ' Genforeningsdag
      If dag = 4 And ugd = 5 And Bro Then ErHelligdag = True
      If dag = 30 And ugd = 1 And Bro Then ErHelligdag = True
      If dag = 31 Then ErHelligdag = True ' Reformationsdag
    End If
    If mnd = 11 Then
      If dag = 1 Then ErHelligdag = True ' Allehelgensdag
      If dag = 2 And ugd = 5 And Bro Then ErHelligdag = True
    End If
    ' Buss- und Bettag: 3. onsdag i oktober
    fokusdato = DateSerial(aar, 11, 1) + 14 _
       + (17 - DatePart("w", DateSerial(aar, 11, 1), vbMonday, vbFirstFourDays)) Mod 7
    If Dato = fokusdato Then ErHelligdag = True
    Select Case (Dato - paaskedato)
      Case -3: ErHelligdag = False ' Skærtorsdag er ikke helligdag i Tyskland
      Case 60: ErHelligdag = True ' Kristi Legems fest
      Case 61: If Bro Then ErHelligdag = True
    End Select
  Else
    ErHelligdag = False
  End If
End Function

Siden er oprettet 25-12-2006 og sidst opdateret 14-01-2007 22:53.

█