"Ivan" <email@adressedurikke.dk> skrev i en meddelelse
news:sMtUb.2931$3t1.2714@news.get2net.dk...
> Dav i gruppen
>
> Jeg har forsøgt at få en database lavet i Excel ind i Access, det kan jeg
> ikke får til at virke:( jeg har forsøgt med det råd jeg fik i en anden
tråd,
> jeg kan ikke få det til at virke.
>
> Hvordan for jeg Excel til at lave en aldersberegning? Jeg har cpr.nr. og
det
> ville jo være nemt og smart hvis jeg kunne få Excel til at vis mig
alderen.
> Det ville være endnu mere "blær" hvis det kunne blive sådan at det kun var
> dem der bliver 50 og 60 år der vises. Kan noget sådan gøre, jeg har prøvet
> men kan ikke få det til at virke som jeg mener det skulle kunne.
>
> Hi
> Ivan
>
Denne funktion beregner alderen ud fra et cpr-nummer. Hvis du fx har
cprnummer i A1, skriver cpralder(a1), der hvor alderen skal beregnes. Du kan
faktisk også bruge den direkte i Access. Kopier koden til et modul. Så kal
du kalde den i en forespørgsel på cpr-nummeret. Dog skal du så angive
feltet, der indeholder cpr-nummeret i stedet for cellen. Skriv fx i en tom
forespørgselskolonne Alder: cpralder([cprnummer]) eller hvad dit felt nu
hedder. Sætter du så et kriterie på fgeltet med aldersberegningen, har du
dem du ønsker (%50 OR 60).
OBS! Koden tager højde for problematikken omkring personer, der er født i
forskellige århundreder.
Jan
Function CprAlder(cpr As String) As Byte
'JKrons, 2002
'Finder alder pga fødsels-århundredet ud af
'et cpr-nummer på formen xxxxxx-xxxx
'Den virker kun indtil 2036, hvor cpr-nummersystemet i
'dets nuværende form ophører med at fungere
'se nærmere på
www.cpr.dk
If Not IsNull(cpr) Then
Dim bytCent As Byte
Dim bytSevdig As Byte
Dim bytCpryear As Byte
Dim bytCprmonth As Byte
Dim bytCprday As Byte
Dim strErrtxt As String
Dim datTemp As Date
strErrtxt = "Der eksisterer ikke lovlige cpr-numre, hvor årstallet er "
bytSevdig = Mid(cpr, 8, 1)
bytCpryear = Mid(cpr, 5, 2)
bytCprmonth = Mid(cpr, 3, 2)
bytCprday = Mid(cpr, 1, 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
Else
strErrtxt = strErrtxt & bytCpryear & " og 7. ciffer er " &
bytSevdig
MsgBox strErrtxt, vbOKOnly + vbCritical, "CPR-nummer fejl"
Exit Function
End If
End Select
datTemp = DateSerial(bytCent & bytCpryear, bytCprmonth, bytCprday)
If datTemp > Date Then
MsgBox "Den pågældende person er ikke født endnu", vbOKOnly +
vbExclamation, "CPR-nummer fejl"
Exit Function
End If
If Mid(datTemp, 7, 2) = 18 Then
CprAlder = Right(DatePart("yyyy", Date - datTemp), 2) + 100
Else
CprAlder = Right(DatePart("yyyy", Date - datTemp), 2)
End If
End If
End Function