falls Ihr auf der Suche nach einer Funktion für die Berechnung der EAN-Prüfziffer auf folgende Funktion (oder deren Abwandlungen) gestoßen seid
Function GetPrüfziffer(cWert As String) As Integer
dann ist Euch vielleicht aufgefallen, dass nicht alle berechneten Prüfziffern korrekt sind !?!
Das liegt daran, dass der Autor damals keinen Unterschied zwischen geraden EANs (EAN-8, EAN-14, UPC-12...) und ungeraden (EAN-13) gemacht hat.
Hier eine Version ohne diesen Mangel ;)
---------------------------------------
'Sub eingefügt um per Einzelschritt (F8) die Funktion GetPrüfziffer zu debuggen
Sub test()
GetPrüfziffer (1234567)
End Sub
Function GetPrüfziffer(cWert As String) As Double'Der Prüfziffern-Algorithmus des EAN-Systems basiert auf einer Gewichtung der einzelnen
'Ziffern der zu prüfenden Nummer mit den Faktoren 3 1 3 1 3 ... von rechts nach links
'und dem Modulo 10. Mit anderen Worten ausgedrückt:
'Die einzelnen Ziffern der EAN-, ILN- oder NVE-Nummer werden von rechts nach links
'- also von hinten nach vorne - abwechselnd mit den Faktoren 3 und 1 multipliziert,
'wobei stets mit Faktor 3 begonnen wird.
'Die Summe dieser einzelnen Produkte (Produktsumme) ist zu ermitteln. Die Differenz
'zwischen der Produktsumme und dem nächsten vollen "Zehner" (Aufrundung) ergibt
'die Prüfziffer.
'Ergibt sich eine durch 10 teilbare Produktsumme, so ist die Prüfziffer gleich Null.
'
'zur Kontrolle: http://www.ean.de/ean/Inhalt/e2/e9 (Prüfziffernrechner der CCG !!!)Dim x As Integer, nSumme As Integer, nLang As Integer
Dim lGerade As BooleannLang = Len(cWert)
Select Case nLang Mod 2
Case 0
lGerade = True 'wenn nLang = gerade
Case Else
lGerade = False 'wenn nLang = ungerade
End SelectFor x = 1 To nLang
lGerade = Not lGerade
If lGerade Then
nSumme = nSumme + Val(Mid$(cWert, x, 1)) * 3
Else
nSumme = nSumme + Val(Mid$(cWert, x, 1)) * 1
End If
Next x
GetPrüfziffer = Int((nSumme + 9) / 10) * 10 - nSummeEnd Function
Code eingefügt mit Syntaxhighlighter 2.1
---------------------------
Die Funktion kann wie folgt aufgerufen werden:
Beispiel:
A1: 123456789012
B1: =A1 & GetEAN(A1)
liefert eine EAN-13 mit Prüfziffer 8: 1234567890128
Ich bin zwar kein VBa-Spezialist, aber mit EAN128 kenn' ich mir aus ;)
Gruß
Jörg S. aus O.
(ab in die Heia ... Gähn ...)