Ændring af CPR til datofelt

Du er nødt til at bruge noget modulus-11-check for at undersøg hvilket århundrede han er født.
Vender lige tilbage med en funktion....

OK thomasjepsen.

Øh, sagde du at du IKKE havde de sidste 4 cifre i CPR-nr\'et?

I så fald kan du ikke vide hvilket århundrede personen er født i!!
Kan du se det?
Jeg har en funktion, som beregner datoen, men den kræver de sidste 4 cifre.

/Thomas

Jo, jeg har de sidste 4 cifre. Det jeg mente var, at jeg ikke havde noget at bruge dem til i denne forbindelse.

Så jeg vil meget gerne hvis du kan hjælpe med din funktion.
MVH/Søren

Okay, du får den her:
(CPR skal angives UDEN bindestreg)

Option Compare Database
Option Explicit

Function OmrCpr(CPR As String) As Date
\'CPR skal angives UDEN bindestreg
    Dim TestSum  As Long
    Dim Fødselsdato As Date
    Dim A As Integer, B As Integer, C As Integer, D As Integer, E As Integer, F As Integer, G As Integer, H As Integer, I As Integer, J As Integer
    Dim Aar As Integer, Mdr As Integer, dag As Integer, Aarhundred As Integer
    Dim Køn As String

    A = Mid(CPR, 1, 1)
    B = Mid(CPR, 2, 1)
    C = Mid(CPR, 3, 1)
    D = Mid(CPR, 4, 1)
    E = Mid(CPR, 5, 1)
    F = Mid(CPR, 6, 1)
    G = Mid(CPR, 7, 1)
    H = Mid(CPR, 8, 1)
    I = Mid(CPR, 9, 1)
    J = Mid(CPR, 10, 1)

    TestSum = (4 * A + 3 * B + 2 * C + 7 * D + 6 * E + 5 * F + 4 * G + 3 * H + 2 * I + J)
    If (TestSum Mod 11) = 0 Then
        OmrCpr = True
    Else
        OmrCpr = False
    End If
On Error GoTo Except
    \'dag = StrToInt(cpr[1]+Cpr[2])
    dag = Int(Mid(CPR, 1, 1) + Mid(CPR, 2, 1))
    \'Mdr = StrToInt(cpr[3]+Cpr[4])
    Mdr = Int(Mid(CPR, 3, 1) + Mid(CPR, 4, 1))
    \'Aar = StrToint(cpr[5]+Cpr[6])
    Aar = Int(Mid(CPR, 5, 1) + Mid(CPR, 6, 1))
    Aarhundred = 0
    Select Case G
        Case 0 To 3: Aarhundred = 1900
        Case 4
        Select Case Aar
            Case 0 To 36: Aarhundred = 1900
            Case 37 To 99: Aarhundred = 2000
        End Select
        Case 5
            Select Case Aar
                Case 0 To 36: Aarhundred = 2000
                Case 58 To 99: Aarhundred = 1800
            End Select
        Case 6
            Select Case Aar
                Case 0 To 36: Aarhundred = 2000
                Case 58 To 99: Aarhundred = 1800
            End Select
        Case 7
            Select Case Aar
                Case 0 To 36: Aarhundred = 2000
                Case 58 To 99: Aarhundred = 1800
            End Select
        Case 8
            Select Case Aar
                Case 0 To 36: Aarhundred = 2000
                Case 58 To 99: Aarhundred = 1800
            End Select
        Case 9
            Select Case Aar
                Case 0 To 36: Aarhundred = 2000
                Case 37 To 99: Aarhundred = 1900
            End Select
    End Select
    OmrCpr = DateSerial(Aarhundred + Aar, Mdr, dag)
    Exit Function
Except:
    OmrCpr = False

End Function

/Thomas

Takker mange gange.

Lige en kommentar til ovenstående. I case 4 er Aarhundred byttet om, skal se ud som nedenfor:

Case 4
      Select Case Aar
            Case 0 To 36: Aarhundred = 2000  <<<< ombyttet
            Case 37 To 99: Aarhundred = 1900 <<<< ombyttet
      End Select
.......

MVH
SWIL