Farvelæg celle hvis cellen indeholder et CPR der ikke overholder modulus 11 tjek

Hvilken kolonne skal testes?

Ville nok være en god ide at se lidt på denne liste:
http://www.eksperten.dk/list/aabnespoergsmaal/graspman

Du får nok hurtigere hjælp hvis du gider rydde op i den.

Nu ved jeg af gode grunde ikke have arket skal bruges til, men se hvad der bl.a. står på Wikipedia:
"Første personnummer uden modulus-11-kontrol er tildelt den 1. oktober 2007, til en mand med et CPR-nummer, der begynder med 010165. CPR registret opfordrer derfor alle brugere af personnumre til at ændre deres IT-systemer, således at de ikke indeholder modulus kontrollen"

Hej,

Det er kolonne A jeg gerne vil genemsøge
Fx A1 til A250

Isskaarup: Mht. modulus kontrol af cpr så er det korrekt at man ikke kan garanterer at et cpr er validt baseret på modulus 11 kontrol. Det er dog meget begrænset med antal af cpr som ikke overholder modulus 11 tjekket (tror det er 0.05 % af befolkningen).
De cpr numre jeg skal tjekke er heldigvis "ældre" end 2007, så jeg håber ikke det bliver et problem.


Nissen2630 (politimand): Hvis du læser de fleste af spørgsmålene jeg har oprettet så vil du nok opdage at jeg ikke har fået løst mit problem og håber er på et tidspunkt er en der kan hjælpe.
Det er vel ikke en synd at bede om hjælp?

Ok - vender tilbage med et bud..

CPRNR forventes at være anført som tekst

Dim antalRækker As Integer, ræk As Integer, cprNr As String
Public Sub kontrolAfCpr()
    antalRækker = ActiveCell.SpecialCells(xlLastCell).row
   
    For ræk = 1 To antalRækker
        cprNr = Range("A" & ræk)
       
        If CheckCprnr(cprNr) = False Then
            Range("A" & ræk).Interior.ColorIndex = 3
        Else
            Range("A" & ræk).Interior.ColorIndex = xlColorIndexNone
        End If
    Next ræk
End Sub
Public Function CheckCprnr(cprNr As String)
Dim cn, vgt(9), res(9), f, sum, rest, chkciff
    vgt(0) = 4
    vgt(1) = 3
    vgt(2) = 2
    vgt(3) = 7
    vgt(4) = 6
    vgt(5) = 5
    vgt(6) = 4
    vgt(7) = 3
    vgt(8) = 2

    cn = cprNr
   
    For f = 1 To 9
        res(f - 1) = Val(Mid(cn, f, 1)) * Val(vgt(f - 1))
    Next f

    sum = 0
    For f = 0 To 8
        sum = sum + res(f)
    Next f
     
    rest = sum Mod 11
   
    If rest = 0 Then
        chkciff = 0
    Else
        chkciff = 11 - rest
    End If
   
    If chkciff = Val(Right(cn, 1)) Then
        CheckCprnr = True
    Else
        CheckCprnr = False
    End If
End Function

Hej Supertekst.

Virklig flot arbejde - du lever op til dit navn :)

Det var præcist det jeg skulle bruge. Du har sparet mig meget tid og sved.
Tak for hurtig hjælp :)

Hilsen G

Hej G

Selv tak - en fornøjelse..

Enig med graspman, Nissen2630 kan dække sit sheriff-behov andetsteds.

"citat
(politimand): Hvis du læser de fleste af spørgsmålene jeg har oprettet så vil du nok opdage at jeg ikke har fået løst mit problem og håber er på et tidspunkt er en der kan hjælpe.
Det er vel ikke en synd at bede om hjælp"