vba Kontrol af personnummer?

Næ, men det kan vi vel lave ;-)
Kan du reglerne for tjekket på sidste ciffer?

Desværre, nej!

det kan jeg

> janvogt

Hvis det kan være dig til nogen hjælp, sender jeg dig her en procedure fra et pascal-program, jeg lavede for 14 år siden til check af cpr-numres lovlighed. Reglen for sidste ciffer er, at det skal passe med en modulus-11 kontrol, men det kan du formentlig læse dig til i pascal-koden. Så er det op til dig at formulere det til regneark. ;-)

Her er pascal-koden:
PROCEDURE Cprcheck (Personnr : Cprstreng ; VAR Test : Boolean ) ;
{ modulus-11-check + test for dag, måned og år }
  VAR
    Sum, I, Dag, Maaned, Aar : Integer ;
    Nummer : Vektor ;
   
  BEGIN { cprcheck }
    FOR I := 1 TO 6 DO
      BEGIN
        Nummer[I.) := Ord(Cprnr[I.)) - Ord (\'0\') ;
      END ; { for }
    FOR I := 7 TO 10 DO { spring over bindestregen }
      BEGIN            {  i den indlæste streng  }
        Nummer[I.) := Ord(Cprnr[I + 1.)) - Ord (\'0\') ;
      END ; { for }
    Sum := 0 ;
    Test := True ;
    FOR I := 1 TO 7 DO                    { Cpr-nummerets 10 cifre }
      Sum := Sum + Nummer[11 - I.) * I ; { ganges bagfra med hhv. }
    FOR I := 2 TO 4 DO                    {  1 2 3 4 5 6 7  2 3 4  }
      Sum := Sum + Nummer[5 - I.) * I ;
    IF Sum MOD 11 <> 0                      { Modulus 11 check }
      THEN Test := False ;
    Dag := Nummer[1.) * 10 + Nummer[2.);{ Datodelen af strengen }
    Maaned := Nummer[3.) * 10 + Nummer[4.) ;{ månedsdel af do.  }
    Aar := Nummer[5.) * 10 + Nummer[6.) ;  { årsdel af do.    }
    IF (Dag < 1) OR (Dag > 31) OR (Maaned < 1) OR (Maaned > 12)
      THEN Test := False ;
    IF ((Maaned = 4) OR (Maaned = 6) OR (Maaned = 9)
        OR (Maaned = 11)) AND (Dag = 31)
      THEN Test := False ;
    IF (Maaned = 2) AND (Dag > 28)
      THEN
        IF (Dag = 29) AND (Aar MOD 4 = 0) { test for skudår }
          THEN Test := True
      ELSE Test := False ;             
  END ; { cprcheck }           

Og dog&#8230;
1. ciffer ganges med 4
2. ciffer ganges med 3
3. ciffer ganges med 2
4. ciffer ganges med 7
5. ciffer ganges med 6
6 . ciffer ganges med 5
7. ciffer ganges med 4
8. ciffer ganges med 3
9. ciffer ganges med 2
10.ciffer ganges med 1

Der skal stå modulus-11 tjek

Helt foroven

Kopier og Indsæt nedenstående kode i et modul og kald funktionerne fra arket således:

=cprnr(\"030456-0345\")  eller  =cprnr(A1)

Men husk at cellen skal være formateret som tekst eller starte med enkelt citationstegn \' ellers går det galt med foranstillede nuller.

Du kan bruge \"mellemrum\", \"bindestreg\" eller \"punktum\" som
adskillelsestegn. De bliver automatisk fjernet af rutinen.

----------------------------------------

Const CPR_NR_VÆGTE As String = \"4327654321\"


Function CprNr(Nummer As String) As String
    CprNr = CheckNummer(Nummer, CPR_NR_VÆGTE)
End Function

Function CheckNummer(Nummer As String, Vægte As String) As String
Dim Counter As Long
Dim Checksum As Long
    CheckNummer = \"Fejl!\"
    Nummer = FjernTegn(Nummer, \" \")
    Nummer = FjernTegn(Nummer, \"-\")
    Nummer = FjernTegn(Nummer, \".\")
    If Len(Nummer) = Len(Vægte) Then
        For Counter = 1 To Len(Vægte)
            Checksum = Checksum + Mid$(Nummer, Counter, 1) * Mid$(Vægte,
Counter, 1)
        Next Counter
        If Checksum Mod 11 = 0 Then CheckNummer = \"I orden!\"
    End If
End Function

Function FjernTegn(Streng As String, Tegn As String) As String
Dim Dummy As Long
    While InStr(Streng, Tegn)
        Dummy = InStr(Streng, Tegn)
        Streng = Left(Streng, Dummy - 1) & Mid$(Streng, Dummy + 1)
    Wend
    FjernTegn = Streng
End Function

>flemmingdahl Jeg ser på det i morgen. Men skal jeg indtaste samtlige 10 cifre i celle a1?

Du kan vælge at skrive følgende i en celle:  =cprnr(\"030456-0345\")  eller henvise til cellen, som indeholder cprnummeret med:  =cprnr(A1)

Men husk at cellen skal være formateret som tekst eller starte med enkelt citationstegn \' ellers går det galt med foranstillede nuller.

Ja, der SKAL være alle 10 cifre f.eks. i A1 eller et andet sted.

>>>slejpnir og khvid
Tak for oplysningerne om modulus 11.

Jeg har lavet et Excel-ark, som gennemgår alle forhold omkring beregning og tjek af CPR-nummer.

Udover at tjekke, om et CPR-nummer er korrekt, er der også mulighed for at få beregnet det sidste ciffer, som er kontrolcifferet.
Flemmingdahl\'s udmærkede VBA-funktion er også inkluderet.

det vil jeg da gerne se jan.

Jeg forstår ikke et suk. Hvis jeg nu anbringer cprnr. i en tekstboks, skal jeg så lave en cmdknap der siger call cprnr, call checknummer, call fjerntegn? - for at få tjekket? Og hvordan får jeg beskeden \"I orden\" frem? Msgbox??

jeg kan sende dig et ark - smid din mail fd@win-consult.com - det skal ikke i en tekstboks.

>Janvogt Kan du ikke vise koden?

>Flemmingdahl Jo, det skal indtastes i en tekstboks. Herefter skal tjekket foretages ved at trykke på en kontrolknap.

ok - jeg kan lave et eks. til dig - send en mail eller vis din email

>flemmingdahl Jeg er ikke hjemme nu, men min kammerats mail er sendt.

Sendt

Ku\' du bruge det ?

Det virker, men jeg kan ikke finde koden til din command-knap?

Altså koden (makroen) under knappen.

Koden under knappen ligger i ark1\'s kodemodul, og ser således ud:

Private Sub CommandButton1_Click()
Dim sSvar As String
    sSvar = CprNr(TextBox1.Text)
    Range(\"A1\") = sSvar
End Sub

>>>slejpnir
Mit ark indeholder ikke kode udover ovenstående, men jeg sender gerne arket.

jan_vogt_hansen@hotmail.com

Højreklik på fanebladet til Ark1 og vælg \"Vis programkode\"

>flemmingdahl Mange tak!
>janvogt Tak gerne!

Mail?

jan>> prøv fd@win-consult.com :-) takker

Ja, jeg så din kommentar flemming. Jeg \"samler\" lige sammen.

:-) pæn mængde eks. efter hånden :-)