Beregn kontrolciffer til FIK kort.

Nedenstående makro beregner kontrolcifferet til betalingsidentifikationen på pengeinstitutternes fælles indbetalingskort, kortart 71. Beregningen udførtes ud fra 14 indtastede cifre, og det beregnede ciffer skal anbringes sidst. Funktionen forudsætter at foranstillede 0'er håndteres ved indtastning med indledende enkeltapostrof, fx '00123456789012.

Makroen er opdateret, så den tager højde for en undtagelse i visse talkombinationer i de første 14 cifre, og den har fået nyt navn. Siden jeg lavede den oprindelige funktion er Excel udvidet med mange rækker og kolonner, så MOD10, som funktionen oprindeligt hed, nu er adressen på en celle i arkene, og en funktion kan ikke hedde det samme som en celle.

Function FIKKontrol(tl As String) As Byte

 ' Erklær nødvendige variable
    Dim c(13) As Integer
    Dim er As Integer

 ' Læg hvert ciffer ind i variabel og gang med 1 eller 2
    c(13) = Mid(tl, 14, 1) * 2
    c(12) = Mid(tl, 13, 1)
    c(11) = Mid(tl, 12, 1) * 2
    c(10) = Mid(tl, 11, 1)
    c(9) = Mid(tl, 10, 1) * 2
    c(8) = Mid(tl, 9, 1)
    c(7) = Mid(tl, 8, 1) * 2
    c(6) = Mid(tl, 7, 1)
    c(5) = Mid(tl, 6, 1) * 2
    c(4) = Mid(tl, 5, 1)
    c(3) = Mid(tl, 4, 1) * 2
    c(2) = Mid(tl, 3, 1)
    c(1) = Mid(tl, 2, 1) * 2
    c(0) = Mid(tl, 1, 1)

' Find tværsummen af variabler, større end 10
    For i = 0 To 13
        If c(i) > 9 Then
            c(i) = CInt(Left(c(i), 1)) + CInt(Right(c(i), 1))
        End If
    Next

' Find tværsummen af alle beregnede variable
    er = 0
    For i = 0 To 13
        er = er + c(i)
    Next

' Undersøg om resten af tværsummen delt med 10 er lig med 0. Hvis det tilfældet så sæt FIK til 0
' Ellers beregn 10 minus resten af tværsummen delt med 10
' Og skriv resultatet i regnearket
    If er Mod 10 = 0 Then
        FIKKontrol = 0
    Else
        FIKKontrol = 10 - er Mod 10
    End If

 End Function


Funktionen bruges på samme måde som Excels indbyggede funktioner. Cellen med de 14 cifre skal angives som argument, fx =FIKKontrol(A1)

- Tilbage til makroer -
- Tilbage til Excel -