Modulus 10

Ups fakturanr. skulle have været:

00000000025001X
00000000025002X
00000000025003X
00000000025004X
00000000025005X
00000000025006X
osv.

Funktionen jeg har anvendt til Tælleren i ovenstående regneark er:
=HVIS(LÆNGDE(B3)=1;B3;VENSTRE(B3;1)+MIDT(B3;2;1))

Funktionen til Modulus 10 rest:
=REST(B7;10)

og til checkciffer:
=HVIS(B9=0;0;10-B9)

Jeg er ikke helt sikker på, hvad det er du gerne vil have, men så vidt jeg lige kan se, så mangler du en funktion til at beregne tværsummen af et tal. Det kan du f.eks. gøre med denne her:

Public Function TværSum(Tal As String) As Integer

TværSum = 0
For i = 0 To Len(Tal) - 1
    TværSum = TværSum + Val(Left(Right(Tal, Len(Tal) - i), 1))
Next i

End Function

SKAL du også have alle mellemrummene?

Ok så har du her en funktion, der også kan beregne produltet:

Public Function CifferProdukt(Tal1, Tal2 As String) As String

CifferProdukt = ""
For i = 0 To IIf(Len(Tal1) < Len(Tal2), Len(Tal1), Len(Tal2)) - 0
    Værdi1 = Val(Left(Right(Tal1, Len(Tal1) - i), 1))
    Værdi2 = Val(Left(Right(Tal2, Len(Tal2) - i), 1))
    If Værdi1 > 0 And Værdi2 > 0 Then
        CifferProdukt = CifferProdukt & Str(Værdi1 * Værdi2)
    End If
Next i

End Function

Du kan kombinere ovenstående og beregne din tværsum af produktet ved f.eks. at skrive:

=TværSum(CifferProdukt(B7;B8))

Hvis du ikke er interesseret i mellemregningerne kan du selvfølgelig også bare lave en funktion, der gør det for dig.

tvc > Prøv at komme med noget feedback, så vi kan se om jeg er på rette spor eller om jeg har afsporet mig selv undervejs :0)

Jeg skal have en funktion til at beregne det 15. ciffer på baggrund af de 14 første i betalingsid'et ved anvendelse af Modulus 10.

Modulus 10 tager hvert ciffer i betalingsid'et og ganger med henholdsvis 1 og 2 jf. ovenstående rækkefølge.

Af produktet af hver af beregningerne tages tværsummen og de 14 tværsummer summeres. Summen divideres med 10 og den rest der fremkommer trækkes fra 10 (hvis nul så 0) herved fremkommer kontrolcifferet.

Jeg vil gerne fremfinde en funktion der i en celle kan beregne kontrolcifferet på baggrund af indtastningen af 14 cifre i en anden celle.

Med venlig hilsen

Tem

Jeg prøver lige at sætte det sammen og vender tilbage lidt senere i aften.

Hvordan kan de så lige være at i eksemplet i dit spørgsmål, har Bet. id 15 cifre? Det er måske bare en fejl?

Vil du indlæse de 14 cifre i en lang smøre (altså som et tal) eller med mellemrum som vist i dit eksempel?

Her er en funktion, der kan beregne kontrolcifferet. Den består af to hjælpefunktioner, og så selve den funktion, som du skal kalde fra di regneark:

' TværSum beregner tværsummen af alle cifre i strengen
'
Function TværSum(Tal As String) As Integer

TværSum = 0
For i = 0 To Len(Tal) - 1
    TværSum = TværSum + Val(Left(Right(Tal, Len(Tal) - i), 1))
Next i

End Function


' CifferProdukt multiplicerer alle cifre i strengen med skiftevis 1 og 2
'
Function CifferProdukt(Tal As String) As String

CifferProdukt = ""
Konstant = 2
i = 0
Tæller = 0
Do Until i = Len(Tal) - 1 Or Tæller = 14
    If Left(Right(Tal, Len(Tal) - i), 1) <> " " Then
        CifferProdukt = CifferProdukt & Val(Left(Right(Tal, Len(Tal) - i), 1)) * Konstant
        Tæller = Tæller + 1
        If Konstant = 1 Then
            Konstant = 2
        Else
            Konstant = 1
        End If
    End If
    i = i + 1
Loop

End Function


' KontrolCiffer er den overordnede funktion, der beregner selve kontrolcifferet.
'
Public Function KontrolCiffer(Tal As String) As Integer

KontrolCiffer = TværSum(CifferProdukt(Tal)) Mod 10
If KontrolCiffer > 0 Then KontrolCiffer = 10 - KontrolCiffer

End Function

For at beregne et kontrolciffer skal du blot skrive

=KontrolCiffer(B4)

Husk at rette B4 til den celle hvor din bet.id står.

sjap

Jeg har forsøgt at køre din VBA på nedenstående tekststreng som gerne skulle give kontrolcifferet 7, men jeg får kontrolcifferet 4.

00000073995094  -    skulle give kontrolcifferet 7

Jeg har lagt VBA'en ind i Modul 1.

Hvad gør jeg forkert?

Kan godt se at min funktion giver en fejl, men så vidt jeg kan se, så skal kontrolcifferet være 0:

0  0  0  0  0  0  7  3  9  9  5  0  9  4
2  1  2  1  2  1  2  1  2  1  2  1  2  1
________________________________________
0  0  0  0  0  0 14  3 18  9 10  0 18  4
0  0  0  0  0  0  5  3  9  9  1  0  9  4

Første linie er dit tal. Anden linie er de tal det skal multipliceres med. Tredie linie er resultatet af multiplikationen, og den fjerde linie er med tværsummen af to-cifrede tal, så alle tal er på et ciffer.

Så vidt jeg kan regne ud, så er summen af cifrene i nederste linie 40, og dermed er der ingen rest ved division med 10, og derfor er kontrolcifret 0.

Ellers er der noget i beregningsmetoden, jeg har misforstået.

Nåh ja, jeg glemte jo lige at rette fejlen i programmet.

I funktionen "CifferProdukt" skal linien

Do Until i = Len(Tal) - 1 Or Tæller = 14

ændres til

Do Until i = Len(Tal) Or Tæller = 14

her er også en kode
1. function giver et checkciffer
2. funktion kan chekke om det 15'ende ciffer er et korrekt checkciffer

Function MakeCheckCiffer(Number As String) As String
Dim Chksum As Long
Dim tsum As Long
Dim x As Long
Const chk As Long = 14
    On Error GoTo fejl
    Chksum = 0
    For x = 1 To chk
        tsum = CInt(Mid(Number, x, 1)) * (1 + (((x + 1) Mod 2)))
        If tsum > 9 Then tsum = CInt(Left(tsum, 1)) + CInt(Mid(tsum, 2, 1))
        Chksum = Chksum + tsum
    Next
    Chksum = Chksum Mod 10
    If Chksum <> 0 Then Chksum = 10 - Chksum
    MakeCheckCiffer = Chksum
    Exit Function
fejl:
    MakeCheckCiffer = "Fejl"
End Function

Function CifferCheck(Number As String) As String
On Error GoTo fejl
If Val(Mid(Number, 15, 1)) = MakeCheckCiffer(Number) Then CifferCheck = "OK" Else CifferCheck = "Forkert"
Exit Function
fejl:
CifferCheck = "Antal cifre er under 15"
End Function

Justeret så den passer med http://www.nordea.dk/sitemod/upload/Root/main_dk/cash_management/Handbog_indbetalingskort_type75.pdf 
kapitel 3.4

Function MakeCheckCiffer(Number As String) As String
Dim Chksum As Long
Dim tsum As Long
Dim x As Long
Const chk As Long = 15
    On Error GoTo fejl
    Chksum = 0
    For x = 1 To chk
        tsum = CInt(Mid(Number, x, 1)) * (1 + (x Mod 2))
        If tsum > 9 Then tsum = CInt(Left(tsum, 1)) + CInt(Mid(tsum, 2, 1))
        Chksum = Chksum + tsum
        Debug.Print tsum;
    Next
    Chksum = Chksum Mod 10
    If Chksum <> 0 Then Chksum = 10 - Chksum
    MakeCheckCiffer = Chksum
    Exit Function
fejl:
    MakeCheckCiffer = "Fejl"
End Function

Function CifferCheck(Number As String) As String
On Error GoTo fejl
If Val(Mid(Number, 16, 1)) = MakeCheckCiffer(Number) Then CifferCheck = "OK" Else CifferCheck = "Forkert"
Exit Function
fejl:
CifferCheck = "Antal cifre er under 16"
End Function

bak > Det ser jo nydeligt ud må man sige. Og så ser det også ud til at din funktion rammer de 7 som tvc nævner (06/03-2005 22:03:10). Til gengæld rammer den vel så ikke de 2 som står i selve spørgsmålet?

Hvis du har ret, er jeg jo blevet "ført bag lyset" :0) Så vidt jeg lige kan se, så er forskellen på din og min beregning, i hvilken rækkefølge der skal multipliceres med 1 og 2.

I spørgmålet har tvc defineret rækkefølgen som (tvc kalder det "vægt"):

21212121212121

men så vidt jeg lige kan se, så er din rækkefølge

12121212121212

Jeg har ingen mulighed for at vide, hvad der er korrekt (selvom jeg måske kan have en frygtelig mistanke), så jeg kan jo kun håbe på at tvc vender tilbage med en forklaring.

Sjap-> jeg tror han har skrevet forkert af. Hvis du ser min henvisning er det samme metode, men der får de 8 som kontrolciffer.

min rækkefølge er 2121 osv.
tsum = CInt(Mid(Number, x, 1)) * (1 + (x Mod 2))
hvis x = 1 (ulige) er x mod 2 = 1 og (1 + (x mod 2)) så lig 2
hvis x = 2 (lige) er x mod 2 = 0 og (1 + (x mod 2)) så lig 1

Bemærk lige at de bruger 15 cifre + 1 kontrolciffer. Jeg tror han mangler et 0 i den der skal give 7

Tjah, eller også har han blot brugt metoden som inspiration, og så opfundet "sin egen" - men jeg tror du har ret.

Ja, det ku' da være. Den er ihvertilfælde alternativ så. Hans betalingId er på 15 cifre, men udregningen forgår kun på 14 :-)

Ellers er her et eksempel
www.tbdl.dk/excel/betalingsid.xls

Kom lige til at tænke over det du skrev, Sjap. Det kunne da sagtens være at han bruger ideen til at lave sin egen fakturakontrol eller andet..

så laver jeg den da om således at man kan sætte cifferantallet i en constant



Const chk  As Long = 16

Function MakeCheckCiffer(Number As String) As Variant
Dim Chksum                As Long
Dim tsum                  As Long
Dim x                      As Long
    On Error GoTo fejl
    Chksum = 0
    For x = 1 To chk - 1
        tsum = CInt(Mid(Number, x, 1)) * (1 + (x Mod 2))
        If tsum > 9 Then tsum = CInt(Left(tsum, 1)) + CInt(Mid(tsum, 2, 1))
        Chksum = Chksum + tsum
    Next
    Chksum = Chksum Mod 10
    If Chksum <> 0 Then Chksum = 10 - Chksum
    MakeCheckCiffer = Chksum
    Exit Function
fejl:
    MakeCheckCiffer = "Fejl"
End Function

Function CifferCheck(Number As String) As String
    On Error GoTo fejl
    If Len(Number) <> chk Then GoTo fejl
    If Val(Mid(Number, chk, 1)) = MakeCheckCiffer(Number) Then
        CifferCheck = "OK"
    Else
        CifferCheck = "Forkert kontrolciffer"
    End If
    Exit Function
fejl:
    CifferCheck = "Forkert antal cifre"
End Function

Og så kan jeg se, at man nok også har rodet lidt med fancy overskrifter - troede lige et øjeblik, at du havde fundet måden til selv at navngive dem på ;0)

Forvirret???

Det forstår jeg godt for der er tilsyneladende mange måder at gøre det på afhængig af korttypen.

På http://alm.nrsbank.dk/ref.aspx?id=171 gives forklaringen på længdens betydning for beregningen med modulus:

Betalingsidenten udfyldes afhængigt af kortarten f.eks.:
Kortart 01 Betalingsidenten må ikke udfyldes
Kortart 04 Betalingsidenten må være 13 - 16 cifre (modulus 10 kontrol).
Kortart 15 Betalingsidenten må være 13 - 16 cifre (modulus 10 kontrol)
Kortart 71 Betalingsidenten må være max. 15 cifre (modulus 10 kontrol)
Kortart 73 Betalingsidenten må ikke udfyldes
Kortart 75 Betalingsidenten må være max. 16 cifre (modulus 10 kontrol)
Ved blank kortart (angives med 2 spaces) skal 1. ciffer i betalingsidenten være 2, 4 eller 8, + 17
cifre + moduluskontrolciffer, i alt bliver betalingsidenten på 19 cifre

det var jeg ikke klar over - beklager!

og sjap jeg vil også gerne beklage at jeg har vildledt dig med hensyn til 2 1 2 osv.

Den virkede på mit eksempel med ikke på andre :-)

Faktisk skal vægtningen begyndes med med et 2-tal men indsat fra højre side af betalingsid'et ex. kontrolciffer.

Jeg har prøvet at hente bak's eksempel på www.tbdl.dk/excel/betalingsid.xls men den giver en fejl i VBA'en og lukker programmet.

Jeg kunne dog se, at der er mulighed for at angive længden af betalingsid'et og så lade modulus teste på dette.

Er det muligt at bygge videre på ovenstående således at funktionen kan anvendes af alle uafhængig af længden af betalingsid?

Sjap og bak, hvis I i fællesskab kan hjælpe mig med dette vil jeg give jer 200 point hver.

Hilsen

TVC

tvc > jeg har uden problemer hentet og afprøvet baks eksempel. Her kører det uden problemer. Hvad er det for en fejl du får?

tvc > Glem det med vildledningen - det er jo blot en mindre detalje i løsningen af problemet :0)
Det vil da frygteligt dejligt med en masse point, men du skal lige være opmærksom på, at reglerne her på stedet er sådan, at der maksimalt må gives 200 point pr. spørgsmål. Så du må ikke bare oprette et nyt spørgsmål, hvor du bare giver flere point for et gammelt spørgsmål. Hvis vi gør os fortjent til det, tror jeg også at både bak og jeg vil være tilfredse med at dele 200.

denne finder id'et uanset længde, dvs at der ikke er bygget fejlfanger på.
Hvis du bruger kortarten kan den selvfølgelig laves om, således at den fanger fejl i længde også.

Function MakeCheckCiffer(Number As String) As Variant
Dim Chksum                As Long
Dim tsum                  As Long
Dim x                      As Long
Dim chk As Long
Dim start As Long
    On Error GoTo fejl
    chk = Len(Number)
    Chksum = 0
    start = 2
    For x = chk To 1 Step -1
        tsum = CInt(Mid(Number, x, 1)) * start
        If start = 2 Then start = 1 Else start = 2
        If tsum > 9 Then tsum = CInt(Left(tsum, 1)) + CInt(Mid(tsum, 2, 1))
        Chksum = Chksum + tsum
    Next
    Chksum = Chksum Mod 10
    If Chksum <> 0 Then Chksum = 10 - Chksum
    MakeCheckCiffer = Chksum
    Exit Function
fejl:
    MakeCheckCiffer = "Fejl"
End Function

Se det er jo blevet en helt nydelig lille funktion. Jeg kan ikke engang finde noget at brokke mig over. Ja, det skulle da lige være at den første CInt strengt taget ikke er nødvendig, men den gør jo ingen skade.

Jeg skulle jo prøve om jeg kunne finde på et eller andet, og så "faldt" jeg over funktionen Choose. Med den kan sætningen

If start = 2 Then start = 1 Else start = 2

erstattes af

start = Choose(start, 2, 1)

Men det er nok tvivlsomt om der er nogen gevinst (udover lidt færre tegn i koden).

Så skal jeg nok holde (for i dag) :0)

du er ved at blive rigtig god, sjap :-)
i det videre forløb har jeg dog brugt

tsum = CInt(Mid(number, x, 1)) * (start + 2)
start = Not start

Aaarghh! Den var jeg også inde på, men kunne ikke lige få den til at virke inde i mit hoved. Måske er det tidspunktet, eller også er mit hoved sådan hele tiden. Under alle omstændigheder er det vist tid til at godnatte :0)

Her lavet funktionerne lidt om og tilføjet en ekstra
Function FindCheckCiffer returnerer et kontrolciffer til en betalingID
Function IsCheckCifferOK chekker om kontrolcifferet i en hel betalingID er korrekt
Function MakeCheckCiffer er motor for de to andre og kan ikke bruges direkte i et regneark.
Jeg har lagt et nyt eksempel her
www.tbdl.dk/excel/betalingsident.xls





Public Function FindCheckCiffer(Number, Cardtype)
    Select Case Cardtype
        Case "01", "73": GoTo fejl
        Case "04", "15": FindCheckCiffer = MakeCheckCiffer(Number, 12, 15)
        Case "71": FindCheckCiffer = MakeCheckCiffer(Number, 1, 14)
        Case "75": FindCheckCiffer = MakeCheckCiffer(Number, 1, 15)
        Case "  ", """  """
            If Left(Number, 1) Like "[2,4,8]" And Len(Number) = 18 Then
                FindCheckCiffer = MakeCheckCiffer(Number, 18, 18)
            Else
                GoTo fejl
            End If
        Case Else: GoTo fejl
    End Select
    Exit Function
fejl:
    FindCheckCiffer = CVErr(xlErrNA)
End Function

Public Function IsCheckCifferOK(Number As String, Cardtype) As String
Dim vTemp                  As Variant
Dim vNumber                As Variant
    vNumber = Left(Number, Len(Number) - 1)
    Select Case Cardtype
        Case "01", "73": GoTo fejl
        Case "04", "15": vTemp = MakeCheckCiffer(vNumber, 12, 15)
        Case "71": vTemp = MakeCheckCiffer(vNumber, 1, 14)
        Case "75": vTemp = MakeCheckCiffer(vNumber, 1, 15)
        Case "  ", """  """
            If Left(vNumber, 1) Like "[2,4,8]" And Len(vNumber) = 18 Then
                vTemp = MakeCheckCiffer(vNumber, 18, 18)
            Else
                GoTo fejl
            End If
        Case Else: GoTo fejl
    End Select
    If vTemp = CInt(Right(Number, 1)) Then
        IsCheckCifferOK = "OK"
    Else
        IsCheckCifferOK = "Ikke OK"
    End If
    Exit Function

fejl:
    IsCheckCifferOK = CVErr(xlErrNA)
End Function

Private Function MakeCheckCiffer(Number, lmin As Long, lmax As Long) As Variant
Dim Chksum                As Long
Dim tsum                  As Long
Dim x                      As Long
Dim chk                    As Long
Dim start                  As Boolean
    On Error GoTo fejl
    If Len(Number) < lmin Or Len(Number) > lmax Then GoTo fejl
    chk = Len(Number)
    Chksum = 0
    start = False
    For x = chk To 1 Step -1
        tsum = CInt(Mid(Number, x, 1)) * (start + 2)
        start = Not start
        If tsum > 9 Then tsum = CInt(Left(tsum, 1)) + CInt(Mid(tsum, 2, 1))
        Chksum = Chksum + tsum
    Next
    Chksum = Chksum Mod 10
    If Chksum <> 0 Then Chksum = 10 - Chksum
    MakeCheckCiffer = Chksum
    Exit Function
fejl:
    MakeCheckCiffer = CVErr(xlErrNA)
End Function

Det skal lige bemærkes at i ovennævte funktioner kræves nu også kortarten

Det er bare super begge to!

I skal have mange tak for hjælpen.

Bak sender du lige et svar, så skal jeg prøve at fordele point?

Vedr. pointfordeling er der så noget jeg skal være opmærksom på nu hvor jeg vil give jer 100 hver og jeg kun har noteret spg. med 150?

Med venlig hilsen

TVC

Ved ikke det med points, det er så sjældent jeg kommer der forbi :-)

Jeg kan ikke få lov til at give flere point end jeg har angivet i spørgsmålet, så hvad siger I til at have dem tilgode?

Jeg har med sikkerhed flere gode spørgsmål til jer to :-)

Hilsen

TVC

tvc > Jeg kan sagtens leve med pointene, så det skal du ikke tænke så meget over :0)

også her :-)

Så siger jeg endnu en gang TAK!

Mvh. TVC

Jeg er klar over at denne tråd er afsluttet for længe siden, men jeg faldt over den, og vil gerne høre, om der er nogen der kan lave en sådan beregning (også til FI-kort, hehe)... Jeg har fakturanumre 010001-01xxxx, 020001-01xxxx osv, og det er også de sidste cifre foran kontrolcifret. Jeg vil bare have, at mit PHP-faktureringssystem selv finder ud af, hvad kontrolcifret er... Når nogen har et svar, opretter vi bare et spørgsmål, hvor jeg giver et x-antal point...