validering personnummer
Hej
Har ett script för validera ett personnummer i en enskild "ruta", hur gör jag för att i exel kunna validera tex. dom nummer som står kolum A i kolumn B med Sant eller Falskt ?
Private Sub Personnummer()
Dim StrRaknare, NamnStr As String, Int1 As Integer, Resultat2, Resultat1 As Integer
Dim b, i As Integer, Int2 As Integer, Siffra As Integer
StrRaknare = ""
Int1 = 0
Int2 = 0
Siffra = 0
NamnStr = Left([Personnummer], 6) & Right([Personnummer], 4)
For b = 1 To Len(NamnStr)
Siffra = Mid(NamnStr, b, 1)
Select Case b
Case 1
StrRaknare = StrRaknare & (Siffra * 2)
Case 3
StrRaknare = StrRaknare & (Siffra * 2)
Case 5
StrRaknare = StrRaknare & (Siffra * 2)
Case 7
StrRaknare = StrRaknare & (Siffra * 2)
Case 9
StrRaknare = StrRaknare & (Siffra * 2)
Case Else
StrRaknare = StrRaknare & Siffra
End Select
Next b
For i = 1 To Len(StrRaknare)
Int1 = Int1 + Mid(StrRaknare, i, 1)
Next i
If Right(Int1, 1) <> 0 Then
Int2 = (Left(Int1, 1) + 1) * 10
Resultat1 = Int2 - Int1
If Right(NamnStr, 1) <> Resultat1 Then
MsgBox "Fraktsedelsnumret är inte rätt ifyllt, var god kontrolera inmatningen !", vbCritical, "Fraktsedelsnumret felaktigt"
End If
Else
Resultat2 = Int2 / 10
If Right(NamnStr, 1) = Resultat2 Then
MsgBox "Personnummret är inte rätt ifyllt, var god kontrolera inmatningen !", vbCritical, "Personnummer felaktigt"
End If
End If
End Sub
PÅ
Svara
Sv: validering personnummer
Gör om subben till en Function som tar en inparameter och returnerar ett Boolskt värde. T.ex:
1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 | Public Function ValidatePnr(Pnr) As Boolean Dim sPnr As String Dim lIdx As Long Dim lNum As Long Dim lSum As Long On Error GoTo ValidatePnr_Err ' Tar bort ev bindestreck och de två första siffrorna vid ev fyrsiffrigt år sPnr = Replace(CStr(Pnr), "-", "") If Len(sPnr) = 12 Then sPnr = Mid$(sPnr, 3) ' Om strängen består av tio tecken går prog igenom dem ett och ett If Len(sPnr) = 10 Then For lIdx = 1 To 9 Step 2 lNum = CLng(Mid$(sPnr, lIdx, 1)) * 2 If lNum > 9 Then lNum = lNum \ 10 + lNum Mod 10 lSum = lSum + lNum + CLng(Mid$(sPnr, lIdx + 1, 1)) Next lIdx ValidatePnr = (lSum Mod 10 = 0) End If Exit FunctionValidatePnr_Err:End Function |
Sedan kan du t.ex. i cellen B1 skriva:
=ValidatePnr(A1)
Då kommer det att stå "SANT" om A1 innehåller ett giltigt personnummer eller "FALSKT" om det inte gör det.
Svara
Sv:validering personnummer
Hej
Min lösning
1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 31 32 33 34 35 36 37 38 39 40 41 42 | Option ExplicitPrivate Sub Command1_Click()Dim tPnr As String'Rätt 10 siffra är 3 Dvs 8604184153. Denna funktion kan du använda på alla data input'postgiro siffror eller kontrollsiffror på Pg/bkg koder. tPnr = "860418-4157" 'Här ser du till att In personnummer ligger tPnr = Replace(tPnr, "-", "") ' om användren slagit 860418-4157If Right$(tPnr, 1) = KontrollSiffra(Left$(tPnr, Len(tPnr) - 1)) Then MsgBox "Ok"Else MsgBox "Fel Pnr"End IfEnd Sub'Min function klarar alla sifferkombinatione 4 - eller många'testa gärna mot postgiro eller något annat.'DVS jag tar fram rätt kontrollsiffra den längst till höger.Private Function KontrollSiffra(ByVal nummer As String) As String'Regel 1. alla beräkningar sker från slutet mot början.'Därför blir det StrReverse'Steg för steg så du kan följa teknikenDim tmpStr As String, sLen As Long, strKsum As StringDim i As Long, Ksum As Long tmpStr = StrReverse(nummer) 'börja alltid bakifrån ! sLen = Len(nummer)'Siffror som skall multipliceras med 2For i = 1 To sLen Step 2 strKsum = strKsum & CStr(CLng(Mid$(tmpStr, i, 1)) * 2)Next 'i'Siffror som skall multipliceras med 1For i = 2 To sLen Step 2 strKsum = strKsum & Mid$(tmpStr, i, 1)Next 'i sLen = Len(strKsum)'Summera alla enskilda siffror tex 16 blir 1 + 6For i = 1 To sLenKsum = Ksum + CLng(Mid$(strKsum, i, 1))Next 'iKsum = 10 - (Ksum Mod 10)If Ksum = 10 Then Ksum = 0'Returnera resultatetKontrollSiffra = CStr(Ksum)End Function |
Svara
Sv:validering personnummer
Även 22 december 2019 var den här posten användbar, nu finns den i mcparken.se
Svara