Zeichenkette prüfen

Hallo zusammen,
ich habe mir ein Makro zusammengebaut welches mir eine Zeichenkette prüfen und bei Abweichungen den dazugehörigen Wert aus einer weiteren Tabelle nehmen soll.
In Spalte A sind EAN-Nummern, in Spalte B sind unterschiedliche Artikelnummern. Die Zeichenkette der Artikelnummern müssen 10 Zeichen lang und zwei Bindestriche besitzen, dann gelten sie als okay. Sind die Artikelnummern abweichend so soll die EAN-Nummer im zweiten Tabellenblatt gesucht werden und die richtige Artikelnummer dazu in Spalte C nachgetragen werden.
Dazu habe ich mal meine Bsp. Datei fertig gemacht, da die Prüfung auf den Syntax (10 Zeichen inklusive zwei "-") nicht richtig funktioniert, wer hat dafür eine Lösung?
https://www.herber.de/bbs/user/133687.xlsm

Beiträge zum Forumthread

Beiträge zu diesem Forumthread

Betreff

Datum

Anwender

Sub Vergleichen() Dim i As Long Dim wksQ As Worksheet Set wksQ = Worksheets("Tabelle2") With Worksheets("Tabelle1") For i = 2 To .Cells(Rows.Count, 1).End(xlUp).Row If Len(.Cells(i, 2)) = 10 And Len(Replace(.Cells(i, 2), "-", "")) = 8 Then .Cells(i, 3) = .Cells(i, 2) Else If WorksheetFunction.CountIf(wksQ.Columns(1), .Cells(i, 1)) = 0 Then MsgBox .Cells(i, 1) & " ist nicht vorhanden." Else .Cells(i, 3) = WorksheetFunction.VLookup(CStr(.Cells(i, 1)), wksQ.Range("A:B"), 2, 0) End If End If Next i End With Set wksQ = Nothing End Sub

Danke ihr Beiden, ich habe das jetzt wie folgt angepasst, sieht auch auf den ersten Blick ganz gut aus. Jetzt erhalte ich jedoch einen Laufzeitfehler 13 wenn die zu suchende EAN Nummer nicht in der Vergleichstabelle ist, woran kann das liegen?
Um das zu provozieren, habe ich einfach eine EAN Nummer um eine Zahl erweitert anschließend kam der Laufzeitfehler.

Sub Vergleichen()
Dim a As Variant
Dim letzte As Long
Dim i As Long
Dim wksQ As Worksheet
Dim wksZ As Worksheet
Set wksQ = Workbooks("ANR mit EAN EKanal Handelsware.xlsx").Worksheets("6154")
Set wksZ = Worksheets("Komsa_Report")
letzte = wksZ.Cells(wksZ.Rows.Count, 9).End(xlUp).Row
For i = 1 To letzte
a = Application.Match(wksZ.Cells(i, 9), wksQ.Columns(1), 0)
If Not wksZ.Cells(i, 12) Like "?-?-?" Then
wksZ.Cells(i, 14).Value = wksQ.Cells(a, 2).Value
ElseIf Not IsNumeric(a) Then
'If Not IsNumeric(a) Then
wksZ.Cells(i, 14).Value = "nicht gefunden"
'MsgBox "nicht vorhanden"
'End If
End If
Next
Set wksQ = Nothing
Set wksZ = Nothing
End Sub

Beliebteste Forumthreads (12 Monate)

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

VBA Beispiele zu verwandten Themen

Beliebteste Forumthreads (12 Monate)

Beliebteste Forumthreads (12 Monate)

10
Beiträge zum Forumthread

Beiträge zu diesem Forumthread