Live-Forum - Die aktuellen Beiträge
Datum
Titel
24.04.2024 04:37:43
Mit Word erstellte PDF als Anhang an E-Mail anhängen
24.04.2024 00:20:14
Bestimmte Spalten als xls exportieren per Makro
23.04.2024 22:08:10
Auflisten in Spalte VBA
23.04.2024 21:33:46
Nur farbige/nicht farbige Zellen markieren
Du findest keine passende Antwort auf Deine Frage?
Stelle Deine Frage in unserem Live-Forum
Anzeige
Archiv - Navigation
172to176
Aktuelles Verzeichnis
Verzeichnis Index
Übersicht Verzeichnisse
Vorheriger Thread
Rückwärts Blättern
Nächster Thread
Vorwärts blättern
Anzeige
HERBERS
Excel-Forum (Archiv)
20+ Jahre Excel-Kompetenz: Von Anwendern, für Anwender
Vorheriger Thread
Vorheriger Thread
Rückwärts Blättern
172to176
172to176
Aktuelles Verzeichnis
Verzeichnis Index
Verzeichnis Index
Übersicht Verzeichnisse
Nächster Thread
Nächster Thread
Vorwärts blättern
Inhaltsverzeichnis

EAN Prüfen

EAN Prüfen
22.10.2002 15:47:40
Bongartz
Hallo

Ich möchte EAN Zahlen überprüfen. EAN sind für Artikelnummern im Handelsbereich. Info unter "http://www.ean.de/Inhalt/e2/e8".

Hier im Forum habe ich eine Funktion gefunden, mit deren Hilfe ich die Prüfziffer einer EAN (Letzte stelle) ermitteln kann.
Die Funktion wird wir wie folgt aufgerufen:
Beispiel:
A1="123456789012"
B1=A1 & GetEAN(A1)
liefert "1234567890128"

Code:

Function GetEAN(cWert As String) As Integer

Dim x As Integer, nSumme As Integer, nLang As Integer
Dim lGerade As Boolean

nLang = Len(cWert)
lGerade = True
For 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
GetEAN = Int((nSumme + 9) / 10) * 10 - nSumme

End Function

     Code eingefügt mit Syntaxhighlighter 1.13

Nun mein Problem, es gibt 8, 13 und 14 stellige EAN.
Ist es möglich die Funktion so zu ändern , das Sie 8, 13, 14 stellige EAN erkennt , die letzte Zahl (Prüfziffer) abschneidet und an deren stelle die Prüfziffer berechnet und einfügt.

Gruß
Bongartz

10
Beiträge zum Forumthread
Beiträge zu diesem Forumthread

Betreff
Datum
Anwender
Anzeige
Re: EAN Prüfen
22.10.2002 16:23:01
Any Body
1. wandle die Nummer in String
2. ermittle Länge
3. Schneide Länge - 1 Zeichen ab
4. ermittle daruas die Prüfziffer und vergleiche

OK ?

hth
Any

Re: EAN Prüfen
22.10.2002 17:36:10
Bongartz
Hallo

ich habs mal mit meinen bescheiden VBA kenntnissen probiert.
Einige Probleme habe ich noch damit.
Kannst Du mir nochmals helfen? Ich habe meine Probleme im Code bezeichnet.

'Hier die Beispiel EAN Nummern zum testen.
Sub Test8()
    GetEAN (12345670)
End Sub

Sub Test13()
    GetEAN (1234567890128#) 'Hier bekomme ich immer eine Raute eingefügt
End Sub

Sub Test14()
    GetEAN (12345678901231#) 'Hier bekomme ich immer eine Raute eingefügt
End Sub

Function GetEAN(strWert As String) As Integer

Dim x As Integer, nSumme As Integer, nLang As Integer
Dim lGerade As Boolean
Dim Länge As Byte

Länge = Len(strWert)
 
If IsNumeric(strWert) And Länge <> 0 Then
         
   Select Case Länge
   Case 8
      Goto Pruefen
   Case 13
      Goto Pruefen
   Case 14
      Goto Pruefen
   Case Else
      'Kann mann eine Fehlermeldung anhängen?
   End Select
 
End If
Exit Function
   
Pruefen:
cWert = strWert
nLang = Len(cWert) - 1  'Wie kann ich die letzte Ziffer abschneiden?
lGerade = True
For 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

GetEAN1 = Int((nSumme + 9) / 10) * 10 - nSumme
'Wie kann ich die Werte zusammenfügen?

End Function

     Code eingefügt mit Syntaxhighlighter 1.13

Gruß
Bongartz

Anzeige
Re: EAN Prüfen
22.10.2002 17:36:22
Bongartz
Hallo

ich habs mal mit meinen bescheiden VBA kenntnissen probiert.
Einige Probleme habe ich noch damit.
Kannst Du mir nochmals helfen? Ich habe meine Probleme im Code bezeichnet.

'Hier die Beispiel EAN Nummern zum testen.
Sub Test8()
    GetEAN (12345670)
End Sub

Sub Test13()
    GetEAN (1234567890128#) 'Hier bekomme ich immer eine Raute eingefügt
End Sub

Sub Test14()
    GetEAN (12345678901231#) 'Hier bekomme ich immer eine Raute eingefügt
End Sub

Function GetEAN(strWert As String) As Integer

Dim x As Integer, nSumme As Integer, nLang As Integer
Dim lGerade As Boolean
Dim Länge As Byte

Länge = Len(strWert)
 
If IsNumeric(strWert) And Länge <> 0 Then
         
   Select Case Länge
   Case 8
      Goto Pruefen
   Case 13
      Goto Pruefen
   Case 14
      Goto Pruefen
   Case Else
      'Kann mann eine Fehlermeldung anhängen?
   End Select
 
End If
Exit Function
   
Pruefen:
cWert = strWert
nLang = Len(cWert) - 1  'Wie kann ich die letzte Ziffer abschneiden?
lGerade = True
For 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

GetEAN1 = Int((nSumme + 9) / 10) * 10 - nSumme
'Wie kann ich die Werte zusammenfügen?

End Function

     Code eingefügt mit Syntaxhighlighter 1.13

Gruß
Bongartz

Anzeige
Laufzeitfehler 6
23.10.2002 00:52:34
Bongartz
Hallo

ich habe inzwischen alles herausgefunden. Nur die letzte Zeile macht mir noch probleme. Laufzeitfehler 6

Wer weiss woran das Liegt?

'Hier die Beispiel EAN Nummern zum testen.
Sub Test8()
    GetEAN (12345670)
End Sub

Sub Test13()
    GetEAN (1234567890128#) 'Hier bekomme ich immer eine Raute eingefügt
End Sub

Sub Test14()
    GetEAN (12345678901231#) 'Hier bekomme ich immer eine Raute eingefügt
End Sub

Function GetEAN(strWert As String) As Integer
   Dim x As Integer, nSumme As Integer, nLang As Integer
   Dim lGerade As Boolean
   Dim Länge As Byte
   Länge = Len(strWert)
 
   If IsNumeric(strWert) And Länge <> 0 Then
      Select Case Länge
      Case 8
         cWert = Left(strWert, 7)
         Goto Pruefen
      Case 13
         cWert = Left(strWert, 12)
         Goto Pruefen
      Case 14
         cWert = Left(strWert, 13)
         Goto Pruefen
      Case Else
         Exit Function
         'Kann mann eine Fehlermeldung anhängen?
      End Select
   End If
   Exit Function
   
Pruefen:
   nLang = Len(cWert)
   lGerade = True
   For 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
   endWert = Int((nSumme + 9) / 10) * 10 - nSumme
   GetEAN = Int(cWert & endWert)   'Laufzeitfehler

End Function

     Code eingefügt mit Syntaxhighlighter 1.13

Gruß
Bongartz

Anzeige
Re: Laufzeitfehler 6
23.10.2002 02:12:12
Nike
Hi,
gib deiner Funktion mal ein bischen mehr Spielraum...

Function GetEAN(strWert As String) As Double

Bye

Nike

Danke jetzt geht die Function mit EAN13
23.10.2002 11:36:34
Bongartz
Hallo

vielen dank. Jetzt muss ich nur noch die Prüfzifferlogik für die 8 und 14 stelligen EAN finden. Dann ist die Function perfekt.

Gruß
Bongartz

EAN Prüfziffer Berechnung für EAN 8, 13 , 14
23.10.2002 12:11:08
Bongartz
Hallo

hier ist die Excel Funktion zum Ermitteln der Prüfziffern.
Im Feld A1 befindet sich die EAN-Nummer in Originallänge.
In Feld B1 einfach = GetEAN(A1) eingeben.
Die Prüfziffer aus A1 wird abgeschnitten und ermittelt.
Das Ergebnis wird in Feld B1 mit der ermittelten Prüfziffer eingestellt.

Hier der Code:

Function GetEAN(strWert As String) As Double
   Dim x As Integer, nSumme As Integer, nLang As Integer
   Dim lGerade As Boolean
   Dim Länge As Byte
   Länge = Len(strWert)
 
   If IsNumeric(strWert) And Länge <> 0 Then
      Select Case Länge
      Case 8
         cWert = Left(strWert, 7)
         nLang = Len(cWert)
         lGerade = True
         For x = 1 To nLang
            lGerade = Not lGerade
            If lGerade Then
                nSumme = nSumme + Val(Mid$(cWert, x, 1)) * 1
            Else
                nSumme = nSumme + Val(Mid$(cWert, x, 1)) * 3
            End If
         Next x
         endWert = Int((nSumme + 9) / 10) * 10 - nSumme
         GetEAN = Int(cWert & endWert)
         Exit Function
      Case 13
         cWert = Left(strWert, 12)
         nLang = Len(cWert)
         lGerade = True
         For 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
         endWert = Int((nSumme + 9) / 10) * 10 - nSumme
         GetEAN = Int(cWert & endWert)
         Exit Function
      Case 14
         cWert = Left(strWert, 13)
         nLang = Len(cWert)
         lGerade = True
         For x = 1 To nLang
            lGerade = Not lGerade
            If lGerade Then
                nSumme = nSumme + Val(Mid$(cWert, x, 1)) * 1
            Else
                nSumme = nSumme + Val(Mid$(cWert, x, 1)) * 3
            End If
         Next x
         endWert = Int((nSumme + 9) / 10) * 10 - nSumme
         GetEAN = Int(cWert & endWert)
         Exit Function
      Case Else
         Exit Function
         'Kann mann eine Fehlermeldung anhängen?
      End Select
   End If

End Function

     Code eingefügt mit Syntaxhighlighter 1.13

Gruß
Bongartz

Anzeige
Re: EAN Prüfen
23.10.2002 15:09:57
Peter Feustel
Hallo Bongartz,


Ich habe ein wenig mit den EAN gespielt, dabei ist folgendes herausgekommen:

In Spalte E habe ich 20 EAN erfasst, davon haben die ersten 17 eine richtige, die 3 letzten eine falsche Prüfziffer.

12345678
1234567890128
12345678901235
7622200004607
9783827261854
3446194180
9783446194182
3468041817
20004369
4009300002642
20036234
4008153845116
66264017710
4006132373230
4008153711862
4043400204988
20032432
13243546
3210987654321
978344619415

Wenn Du nun das Makro darüber laufen lässt, wird Dir in Spalte F die ermittelte Prüfziffer ausgegeben und in Spalte G der Hinweis, ob die Prüfziffer in Ordnung war oder aber nicht.

Sub EAN_Pruefung()

Dim strwert As String
Dim intLaenge As Integer
Dim intIndx As Integer

For intIndx = 1 To 20
' die Länge der EAN ermitteln
intLaenge = Len(Cells(intIndx, 5).Value)
' die EAN ohne Prüfziffer in ein Arbeitsfeld bringen
strwert = Left(Cells(intIndx, 5).Value, (intLaenge - 1))
' Die Function GetEAN aufrufen und die PZ nach Spalte F bringen
Cells(intIndx, 6).Value = GetEAN(strwert)
' wenn die Original EAN = EAN Arbeitsfeld (ohne PZ) +
' ermittelte PZ ist dann = OK sonst = Fehler
If Cells(intIndx, 5).Value = strwert & Cells(intIndx, 6).Value Then
Cells(intIndx, 7) = "OK"
Else
Cells(intIndx, 7) = "Fehler"
End If
Next intIndx

End Sub

'
' die Prüfziffer der EAN-Nummer errechnen
' =======================================
'
Function GetEAN(strwert As String) As Integer

Dim intIndx As Integer
Dim intSumme As Integer
Dim intLang As Integer
Dim blnGerade As Boolean

intLang = Len(strwert)
blnGerade = True
For intIndx = 1 To intLang
blnGerade = Not blnGerade
If blnGerade Then
intSumme = intSumme + Val(Mid$(strwert, intIndx, 1)) * 3
Else
intSumme = intSumme + Val(Mid$(strwert, intIndx, 1)) * 1
End If
Next intIndx
GetEAN = Int((intSumme + 9) / 10) * 10 - intSumme

End Function


Versuch es doch so einmal, dabei ist es völlig unerheblich, ob Du eine acht- oder 13-stellige EAN prüfen willst. – Was ist eine 14-stellige EAN, von der Du berichtest?


Gruß, Peter

Anzeige
Re: EAN Prüfen
23.10.2002 22:21:13
Bongartz
Hallo Peter

das ist Genau das was ich noch brauchte. Werde ich gleich mal ausprobieren.
Die EAN-14 wird teilweise bei Produkten aus USA verwendet.
Ich Arbeite bei einem Lebensmittelvertrieb und wir Importieren aus USA.
Wir haben aber auch noch DUN (14 stellig) bei einigen Produkten.
DUN-14 (USA)
Nach dem internationalen Standard aufgebaute 14-stellige Identnummer.
Diese Nummer kann nicht im EAN-13-Strichcodesymbol dargestellt werden.
http://www.infomax-usa.com/dun14.htm

Hier ein paar Links zu EAN Prüfziffer. Ich habe auch noch ein VBA Beispiel gefunden.
http://www.strichcodeservice.at/andere_check_digits.htm#EAN_PZ
http://www.kraasch.de/vba031.htm

Gruß
Bongartz



Anzeige
EAN Prüfen oder Korrigieren
24.10.2002 12:15:56
Bongartz
Hallo Peter

vielen dank noch mal für Dein Beispiel. Ich habe mir zwei verschieden Funktion erstellt. Eine zum korrigieren der EAN und eine zweite Funktion zum Prüfen der EAN.
Die zweite Funktion stellt dann ein OK bzw. Fehler in das Feld.
Die Funktionen werden mit "=GetEAN(Position der zu Prüfenden EAN)" und
"=CheckEAN(Position der zu Prüfenden EAN)" aufgerufen.
Beispiel1:
A1="1234567890120"
B1=GetEAN(A1)
liefert "1234567890128"
Beispiel2:
A1="1234567890120"
C1=CheckEAN(A1)
liefert "Falsch"
oder
A1="1234567890128"
B1=CheckEAN(A1)
liefert "EAN-14 OK"

Gruß
Bongartz

Hier der Code:

' Funktion ermittelt die korrekten EAN(8,13,14), UPC und DUN(14) Prüfziffern und
' übergibt die korrekt EAN in das Feld, von der die Funktion aufgerufen wurde.
Function GetEAN(strWert As String) As Double
   Dim x As Integer, nSumme As Integer, nLang As Integer
   Dim endWert As String
   Dim lGerade As Boolean
   Dim Länge As Byte
   Länge = Len(strWert)
 
   If IsNumeric(strWert) And Länge <> 0 Then
      Select Case Länge
      Case 8
         cWert = Left(strWert, 7)
         lGerade = False
         Goto Berechnen
      Case 12
         cWert = Left(strWert, 11)
         lGerade = False
         Goto Berechnen
      Case 13
         cWert = Left(strWert, 12)
         lGerade = True
         Goto Berechnen
      Case 14
         cWert = Left(strWert, 13)
         lGerade = False
         Goto Berechnen
      Case Else
         Exit Function
      End Select
   End If

Berechnen:
   nLang = Len(cWert)
   For 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
   endWert = Int((nSumme + 9) / 10) * 10 - nSumme
   GetEAN = Int(cWert & endWert)

End Function
' Funktion ermittelt die korrekten EAN(8,13,14), UPC und DUN(14) Prüfziffern und
' übergibt in das Feld von der die Funktion aufgerufen wurde ein "***-OK" oder "Fehler".
Function CheckEAN(strWert As String) As Variant
   Dim x As Integer, nSumme As Integer, nLang As Integer
   Dim endWert As String
   Dim lGerade As Boolean
   Dim Länge As Byte
   Länge = Len(strWert)
 
   If IsNumeric(strWert) And Länge <> 0 Then
      Select Case Länge
      Case 8
         strEAN = "EAN-8 OK"
         rWert = Right(strWert, 1)
         cWert = Left(strWert, 7)
         lGerade = False
         Goto Berechnen
      Case 12
         strEAN = "UPC-12 OK"
         rWert = Right(strWert, 1)
         cWert = Left(strWert, 11)
         lGerade = False
         Goto Berechnen
      Case 13
         strEAN = "EAN-13 OK"
         rWert = Right(strWert, 1)
         cWert = Left(strWert, 12)
         lGerade = True
         Goto Berechnen
      Case 14
         strEAN = "EAN-14,DUN OK"
         rWert = Right(strWert, 1)
         cWert = Left(strWert, 13)
         lGerade = False
         Goto Berechnen
      Case Else
         CheckEAN = "Fehler"
         Exit Function
      End Select
   End If

Berechnen:
   nLang = Len(cWert)
   For 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
   endWert = Int((nSumme + 9) / 10) * 10 - nSumme
   If rWert = endWert Then
      CheckEAN = strEAN
   Else
      CheckEAN = "Fehler"
   End If

End Function

     Code eingefügt mit Syntaxhighlighter 1.13



Anzeige

Beliebteste Forumthreads (12 Monate)

Anzeige
Jetzt das Excel-Portal bewerten: Deine Stimme zählt!

Beliebteste Forumthreads (12 Monate)

Anzeige
Anzeige
Anzeige