Prüfziffer erstellen

Hallo!

Public Function AI(cZelle As String) As String
    Select Case cZelle
    
    Case "A"
         AI = "10"
    Case "B"
         AI = "11"
    Case "C"
         AI = "12"
    Case "D"
         AI = "13"
    Case "E"
         AI = "14"
    Case "F"
         AI = "15"
    Case "G"
         AI = "16"
    Case "H"
         AI = "17"
    Case "I"
         AI = "18"
    Case "J"
         AI = "19"
    Case "K"
         AI = "20"
    Case "L"
         AI = "21"
    Case "M"
         AI = "22"
    Case "N"
         AI = "23"
    Case "O"
         AI = "24"
    Case "P"
         AI = "25"
    Case "Q"
         AI = "26"
    Case "R"
         AI = "27"
    Case "S"
         AI = "28"
    Case "T"
         AI = "29"
    Case "U"
         AI = "30"
    Case "V"
         AI = "31"
    Case "W"
         AI = "32"
    Case "X"
         AI = "33"
    Case "Y"
         AI = "34"
    Case "Z"
         AI = "35"
    Case Else
         AI = cZelle
    End Select
End Function

=RECHTS((AI(TEIL(D5;1;1))*7)+(AI(TEIL(D5;2;1))*3)+(AI(TEIL(D5;3;1))*1)+(AI(TEIL(D5;4;1))*7)+(AI(TEIL(D5;5;1))*3)+(AI(TEIL(D5;6;1))*1)+(AI(TEIL(D5;7;1))*7)+(AI(TEIL(D5;8;1))*3)+(AI(TEIL(D5;9;1))*1);1)

Mit diesen Funktionen generiere ich eine Prüfziffer. Nun erscheint mir das nicht gerade elegant. Das geht doch sicher besser? Z.B. per Schleife. Nur kenne ich mich mit Schleifen nicht. aus. Den Anfang habe ich schon mal geschrieben. Die Zeichenlänge kann unterschiedlich sein (6, 7, 8, 10. Mindestlänge ist 6), daher "Optional lngLänge As Long = 6".

Public Function CreateCheckDigit(cZelle As String, Optional lngLänge As Long = 6) As String

  Dim c1, c2, c3, lnGC, test
  
  test = 645
  
   ' Zu tauschende Zeichen
   c1 = Array(A, B, C, D, E, F, G, H, I, J, K, L, _
              M, N, O, P, Q, R, S, T, U, V, W, X, _
              Y, Z, 0, 1, 2, 3, 4, 5, 6, 7, 8, 9)

   ' Zeichen mit denen "c1" getauscht werden soll
   c2 = Array(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, 0, _
              1, 2, 3, 4, 5, 6, 7, 8, 9)
             
   ' Erstes Zeichen mit 7 multiplizieren, zweites Zeichen mit 3, drittes Zeiche mit 1, _
     ab dem nächsten Zeichen wieder von vorn.
   c3 = Array(7, 3, 1)

   For lnGC = 0 To UBound(c1)
       CreateCheckDigit = CreateCheckDigit & "?"  'Right(test, 1)
   Next lnGC

   CreateCheckDigit = Right(test, 1)
   
End Function

Danke!

Gruß, René

Beiträge zum Forumthread

Beiträge zu diesem Forumthread

Betreff

Datum

Anwender

Function Prüfziffer(txt As String) As Long Dim Summe As Long Dim Faktor Dim i As Long Dim T As String Faktor = Array(1, 7, 3) Dim F As Long For i = 1 To Len(txt) F = Faktor(i Mod 3) T = Mid(txt, i, 1) If T Like "#" Then Summe = Summe + CLng(T) * F Else Summe = Summe + (Asc(T) - Asc("A") + 10) * F End If Next Prüfziffer = Summe Mod 10 End Function

naja, wenn dich das Array irrtiert hat, warum fragst du dann nicht gleich danach?
naja, ist ja auch einfacher erstmal ein "dein Code funktioniert nicht" rauszuhauen, obwohl du das warscheinlich nicht einmal ausprobiert hast.
Sorry, aber das ist einfach unhöflich und lässt mich drüber nachdenken, ob kostenlose Hilfe wirklich das richtige ist.
aber seis drum.
das prinzip ist einfach (Rest = Mod):
Rest(1;3) =1
Rest(2;3) = 2
RestI(3;3) =0
Rest(4;3) = 1
Rest(5;3) = 2
Rest(6;3) = 0

also die Rest-Funktion spuckt beim jedem dritten Element nicht 3, sondern 0 als Ergebnis aus.

das nächste was man wissen muss, dass in VBA bei Arrays normalerweise der erste Index immer der Index 0 ist und nicht 1.
Also mit
x = Array("a", "b", "c")
ist
x(0) = "a"
x(1) = "b"
x(2) ="c"
x(3) = Fehler!

damit sollte sich die Reihenfolge erklären.

und in Zukunft bitte erste prüfen, dann meckern.
Danke.

Function Prüfziffer(txt As String) As Long Dim i As Long For i = 1 To Len(txt) Prüfziffer = Prüfziffer + InStr("123456789ABCDEFGHIJKLMNOPQRSTUVWXYZ", Mid(txt, i, 1)) * Array(1, 7, 3)(i Mod 3) Next Prüfziffer = Prüfziffer Mod 10 End Function

If Left(Range("D4"), 2) Format(Now, "YY") Then Range("D15").Value = "Der Personalausweis ist abgelaufen" Range("D15").Font.Color = vbRed Else Range("D15").Value = "Personalausweis ist gültig" Range("D15").Font.Color = vbGreen End If

Public Function CreateCheckDigit(txt As String) As Long Dim le, i, co, pos, a, fa le = Len(txt) If Not IsNumeric(Right(txt, 1)) Then txt = Left(txt, le - 1): le = le - 1 txt = Left(txt, le - 1): le = le - 1 fa = 1 For i = 1 To le fa = Int(fa / 2): If fa 1 Then fa = 7 a = Mid(txt, i, 1): co = Asc(a) If (co >= 48 And co = 57) Then co = co - 48 ElseIf (co >= 65 And co = 90) Then co = co - 55 End If CreateCheckDigit = CreateCheckDigit + fa * co Next i End Function

Public Function CreateCheckDigit(txt As String) As Long Dim le, i, co, pos, a, fa As Integer le = Len(txt) If Not IsNumeric(Right(txt, 1)) Then txt = Left(txt, le - 1): le = le - 1 txt = Left(txt, le - 1): le = le - 1 fa = 1 For i = 1 To le fa = Int(fa / 2): If fa 1 Then fa = 7 a = Mid(txt, i, 1): co = Asc(a) If (co >= 48 And co = 57) Then co = co - 48 ElseIf (co >= 65 And co = 90) Then co = co - 55 End If CreateCheckDigit = CreateCheckDigit + fa * co Next i CreateCheckDigit = CreateCheckDigit - (Int(CreateCheckDigit / 10)) * 10 End Function

Beliebteste Forumthreads (12 Monate)

52
Beiträge zum Forumthread

Beiträge zu diesem Forumthread

Links zu Excel-Dialogen

Beliebteste Forumthreads (12 Monate)

Beliebteste Forumthreads (12 Monate)

Prüfziffer erstellen

52 Beiträge zum Forumthread Beiträge zu diesem Forumthread

VBA Beispiele zu verwandten Themen

Links zu Excel-Dialogen

Beliebteste Forumthreads (12 Monate)

Beliebteste Forumthreads (12 Monate)

52
Beiträge zum Forumthread

Beiträge zu diesem Forumthread