Fødselsdato og alder ud fra CPR nummer

Et dansk CPR-nummer er forholdsvis nemt gennemskueligt. Det består af to grupper men henholdsvis 6 og fire cifre, normalt adskilt af en bindestreg, fx 140408-2996.

De første seks cifre er fødselsdagen og de sidste fire er løbenummer, kønsbestemmelse og tidligere også kontrolciffer. Det sidste er dog afskaffet, hvorfor det ikke er interessant at lave det såkaldte Modulus 11 check af nyere cpr-numre. Numre, der er tildelt før afskaffelsen (1-10-2007) kan stadig kontrolleres, men da man ikke kan se på nummeret, hvornår det er tildelt - den første, der fik et af de nye numre, var en mand, født den 01-01-1965, ikke en nyfødt - anbefaler cpr-registeret, at virksomheder, der anvender modulus 11 kontrol, afskaffer denne i deres it-systemer.

Det var imidlertid ikke det, der var temaet for denne artikel :-), men derimod omdannelsen af et cpr-nummer til en fødselsdag. Dag og måned er nemt, da det kan aflæses direkte af de første fire cifre  i cpr-nummeret. Pigen eller kvinden med ovenstående cpr-nummer er således født den 14. april.  Det er der ingen tvivl om. Derimod kan man komme i tvivl om, hvilket århundrede hun er født i. Er hun fra 1908 eller 2008? Er en person med årstallet 98 fra 1998 eller 1898? Dette kan afgøres af cpr-nummerets syvende ciffer, som netop fortæller om århundredet efter et sindrigt system:

• Er 7. ciffer 0, 1, 2 eller 3 er man altid født i 19xx.
• Er 7. ciffer 4 eller 9, er man født i 19xx, hvis årstalscifrene er større end 36. Er de mindre end eller lig 36 er man født i 20xx.
• Er 7. ciffer 5, 6, 7, eller 8 og årstalscifrene mindre end eller lig 36 er man født i 2000. Er årstalscifrene større end eller lig 58 er man født i 18xx. Cpr-numre med de nævnte startcifre uddeles ikke til personer, med årstalscifre fra og med 37 til og med 57.

Dette kan være lidt vanskeligt at overskue i hovedet, men nedenstående funktion "oversætter" cpr-numre til "rigtige" datoer i Excels datoformat.

Public Function CprTilDato(cpr As String) As Date

    Dim bytCent As Byte
    Dim bytSevdig As Byte
    Dim bytCprYear As String

    If Not IsNull(cpr) Then

        bytSevdig = Mid(cpr, 8, 1)
        bytCprYear = Mid(cpr, 5, 2)

        Select Case bytSevdig
            Case 0 To 3
                bytCent = 19
            Case 4, 9
                If bytCprYear <= 36 Then
                    bytCent = 20
                Else
                    bytCent = 19
                End If
            Case 5 To 8
                If bytCprYear <= 36 Then
                    bytCent = 20
                ElseIf bytCprYear >= 58 Then
                    bytCent = 18
                End If
        End Select

        CprTilDato = Left(cpr, 2) & "-" & Mid(cpr, 3, 2) & "-" & bytCent & bytCprYear
End If

End Function

Funktionen vil som alle funktioner udelukkende returnere en værdi, og cellen, der indeholder funktionen, skal derfor formateres i det ønskede datoformat. NB! Er personen født i 18xx bliver den returnerede værdi negativ, og i så fald kan den ikke formateres som en dato, da Excel ikke kender datoer før 1-1-1900. Prøver man at formatere som datovil Excel vise et næsten uendeligt antal #############.

Funktionen kan omskrives til en makro, se nederst i denne artikel. I så fald kan makroen selv formatere værdierne til dato og den kan også håndtere at få skrevet fx 10-11-1893.

Hvad med "tastefejl"?

Det sker at nogen vælger at taste cpr-nummret uden bindestreg. I så fald vil ovenstående ikke virke korrekt. Skal koden ændres, så den tager højde for muligheden af, at der indtastes uden bindestreg, kan linjerne lige efter If Not IsNull(cpr) ændres til

    If Len(cpr) = 11 Then
        bytSevdig = Mid(cpr, 8, 1)
    Else
        bytSevdig = Mid(cpr, 7, 1)
    End If

Herefter følger så linjen

     bytCprYear = Mid(cpr, 5, 2)

og resten af koden er uændret. Koden kan efter behov udbygges med håndtering af andre fejlindtastning, fx at et evt. foranstillet 0 er slettet og osv. Det vil jeg dog ikke komme ind på her.

Beregn alder
Ændret 16-2-11

Når først fødselsdagen er beregnet kan man selvfølgelig også beregne alderen i forhold til dags dato. Det gør nedenstående funktion. Den er baseret på at ovenstående funktion er til rådighed og kan kaldes. Alternativt kunne man have en enkelt funktion, som først oversatte til fødselsdag og så beregnede alderen. Her er de altså to separate funktioner. I den første version af denne funktion, var der en fejl, så visse fødlsesdage gav en forkert alder. Denne fejl blev påpeget af Poul Aggerholm og tak for det. Pouls løsning er denne:

Function CprAlder(cpr2 As String)
    CprAlder = CprTilDato(cpr2)
    If Month(CprAlder) > Month(Date) Or Month(CprAlder) = Month(Date) And Day(CprAlder) > Day(Date) Then
        CprAlder = DateDiff("yyyy", CprAlder, Now) - 1
    Else
        CprAlder = DateDiff("yyyy", CprAlder, Now)
    End If
End Function

I første omgang kalder CprAlder CPRTilDato for at få oversat cpr-nummret til en dato. Dernæst beregnes alderen ved hjælp af VBA funktionen DateDiff, som ikke må forvekles med regnearksfunktionen Datedif (et f) eller Dato.Forskel, som den kaldes på dansk (se artiklen Excels Hemmelige funktion).

Argumentet "yyyy" til Datediff returnerer imidlertid altid forskellen mellem de to årstal, og det er knap så heldigt. Er man født fx den 31-12-1999 vil man i dag (26. januar 2010) være 11 år gammel. For de fleste menneskers vedkommende indtræffer den alder dog først når man har haft fødselsdag. Hvis betingelsen sikrer, at alderen regnes rigtigt.

Bemærk at denne funktion kan beregne alderen uanset om personen er født før eller efter 1-1-1900.

Sub til at lave datoer i stedet for Function

Som nævnt ovenfor, kan en funktionsmakro kun indsætte en værdi, ikke en formateret sådan. Derfor er man nødt til selv at formatere som dato. I stedet kan man omskrive funktionen til en makro, som indsætter fødselsdagen. Nedenstående makro er baseret på, at markøren er baseret i en celle, der indeholder et cpr-nummer, når den afspilles. Fødselsdagen indsættes så i cellen til højre for den aktive celle. NB! Denne kode er ikke "modificeret" for fejlindtastninger, og forventer derfor et cpr-nummer i formatet ddmmåå-xxxx, altså med bindestreg.

Sub TilDato()
    Dim bytCent As Byte
    Dim bytSevdig As Byte
    Dim bytCprYear As String
    Dim CprTilDato As Date

    bytSevdig = Mid(ActiveCell.Value, 8, 1)
    bytCprYear = Mid(ActiveCell.Value, 5, 2)

    Select Case bytSevdig
        Case 0 To 3
            bytCent = 19
        Case 4, 9
            If bytCprYear <= 36 Then
                bytCent = 20
            Else
                bytCent = 19
            End If
        Case 5 To 8
            If bytCprYear <= 36 Then
                bytCent = 20
            ElseIf bytCprYear >= 58 Then
                bytCent = 18
            End If
        End Select
     CprTilDato = Left(ActiveCell.Value, 2) & "-" & Mid(ActiveCell.Value, 3, 2) & "-" & bytCent & bytCprYear
     ActiveCell.Offset(0, 1) = Format(CprTilDato, "dd-mm-yyyy")
End Sub

I modsætning til funktionen, hvor brugeren selv skal formatere resultatcellen, vil denne makro automatisk formatere. Ligger datoen før 1-1-1900, vil makroen alligevel kunne skrive den, men man skal være opmærksom på, at datoer før 1-1-1900 ikke kan registreres i Excel, og regnearket vil derfor opfatte datoer fra før denne dato som en tekst, ikke som en dato, og de kan derfor ikke indgå i videre beregninger i modsætning til datoer efter 31-12-1899, som vil opfattet som "rigtige" datoer.

Eksempler

Alderen er beregnet pr. 26-1-2010.

- Tilbage til makroer -
- Tilbage til Excel -