Barcodes einlesen und abgleichen

Hallo,
ich habe einen Barcodescanner mit dem ich Zahlen/Buchstabenkombinationen einlesen möchte.
In Sheet 1 habe ich eine wirklich lange Liste in Spalte B stehen, ebenfalls Zahlen/Buchstabenkombinationen.
Nun möchte ich im Sheet 2 - Spalte A meine Barcodes einlesen. Das einlesen funktioniert auch ganz ohne Probleme.
Problem ist das abgleichen, wird ein Barcode eingelesen, so soll in Sheet 1 in der Zeile wo der Barcode gefunden wird,
bestenfalls das Datum in die Nachbarspalte / Spalte C plaziert werden. Das ganze entweder live oder per Button nachdem
ich die Barcodes eingelesen habe.
Die Barcodes werden mit einem mal ins Excel importiert und haben folgenden Aufbau:
MEINQR200000001 2021/04/07 17:49:56
Habt Ihr eine Idee?
Liebe Grüße
Vanessa

Beiträge zum Forumthread

Beiträge zu diesem Forumthread

Betreff

Datum

Anwender

Hi Vanessa,
füge ein Modul in die Datei ein, speichere sie als *.xlsm und kopiere folgenden Code in das Modul:

Sub IsQRThere()
On Error GoTo hell
Dim LastRow As Long
Dim FindRow As Long
Dim z As Long
Dim MyArr
Dim MyErrMsg As String
Dim ShowErr As Boolean
ShowErr = False
MyErrMsg = "Nicht gefunden:" & Chr(10)
With Sheets("QR-Code")
LastRow = .Cells(.Rows.Count, 1).End(xlUp).Row
For z = 2 To LastRow
MyArr = Split(.Cells(z, 1), " ")
FindRow = WorksheetFunction.Match(MyArr(0), Sheets("Datenliste").Columns("A"), False)
If Not FindRow = 0 Then
With Sheets("Datenliste")
.Cells(FindRow, 4).Value = "ja"
.Cells(FindRow, 5).Value = MyArr(1)
.Cells(FindRow, 6).Value = MyArr(2)
End With
End If
Next z
End With
hell:
If Err.Number = 1004 Then
MyErrMsg = MyErrMsg & MyArr(0) & Chr(10)
FindRow = 0
ShowErr = True
Resume Next
End If
If ShowErr Then
MsgBox MyErrMsg
Debug.Print MyErrMsg
End If
End Sub

Das sollte es eigentlich machen.
Bitte beachte, dass ich auf eine ausführliche Fehlerbehandlung verzichtet habe - kommt ein falscher QR Code (zum Beispiel ohne Datum), schmiert das Programm ab. Korrekte QR-Codes, die aber in "Datenliste" nicht vorkommen, werden gesammelt und gemeldet.
Übrigens:
ICH hätte die QR-Codes selbst eher per "Text in Spalten" zerlegt und die Namen dann per SVERWEIS dazu gepackt. Wenn du nur ein paar hundert Datensätze hast ist es egal, aber wenn es ein paar hunderttausend werden wäre das eine deutlich schnellere Lösung. Wenn du daran Interesse hast, kurz melden.
LG,
Klaus M.

Sub Makro1() Dim lRow As Long Sheets("QR-Code").Columns("A:A").TextToColumns Destination:=Sheets("QR-Code").Range("A1"), _ DataType:=xlDelimited, _ TextQualifier:=xlDoubleQuote, ConsecutiveDelimiter:=True, Tab:=False, _ Semicolon:=False, Comma:=False, Space:=True, Other:=False, FieldInfo _ :=Array(Array(1, 1), Array(2, 1), Array(3, 1)), TrailingMinusNumbers:=True With Sheets("Datenliste") lRow = .Cells(.Rows.Count, 1).End(xlUp).Row .Range("D2:D" & lRow).FormulaR1C1 = "=IF(RC5="""","""",""ja"")" .Range("E2:F" & lRow).FormulaR1C1 = "=IFERROR(VLOOKUP(RC1,'QR-Code'!C1:C3,COLUMN(R1C[-3]),), _ """")" .Columns("E:E").NumberFormat = "dd-mmm-yyyy" .Columns("F:F").NumberFormat = "h:mm;@" .Range("D2:F" & lRow).Value = .Range("D2:F" & lRow).Value End With End Sub

Beliebteste Forumthreads (12 Monate)

8
Beiträge zum Forumthread

Beiträge zu diesem Forumthread

22 Forumthreads zu ähnlichen Themen

Beliebteste Forumthreads (12 Monate)

Beliebteste Forumthreads (12 Monate)

Barcodes einlesen und abgleichen

8 Beiträge zum Forumthread Beiträge zu diesem Forumthread

22 Forumthreads zu ähnlichen Themen

VBA Beispiele zu verwandten Themen

Beliebteste Forumthreads (12 Monate)

Beliebteste Forumthreads (12 Monate)

8
Beiträge zum Forumthread

Beiträge zu diesem Forumthread