macros aus gescanntem EAN >Code

Scanne ich Artikel "XYZ" ein dann werden in der Reihe für diesen Artikel die Daten eingetragen und der Zähler für die Anzahl auf "1" gesetzt. Bei Artikel "ABC" analog die entsprechenden Daten.
Scanne ich den Artikel "XYZ" nochmals ein, sollte erkannt werden das dieser Datensatz schon vorhanden ist und nur noch die Anzahl "+1" erhöht werden.
Somit kann man dann Verschiedene Artikel einfach einscannen und hat am Ende eine Liste mit den (für mich) relevanten Daten aufbereitet.
Wichtig ist auch noch die Sortierung in der Spalte A Nach BPV und VV. Ansonsten habe ich keine Möglichkeit diese Liste "sortiert" aus zu drucken.
--- schnapp ---
Viel erfolg damit
Einen Auszug aus der aktuellen liste ist hier zu finden:
https://www.herber.de/bbs/user/24979.xls

Beiträge zum Forumthread

Beiträge zu diesem Forumthread

Betreff

Benutzer

Hallo
hab mal was gebastelt:
Die AktuelleRemi.xls muß nicht geöffnet werden, die Daten werden aus der geschlossenen Datei gelesen.
Ich habe deine Musterdatei als AktuelleRemi.xls verwendet..
Ein Problem hab ich festgestellt.. Du hast unterschiedlichen Zeitungen den gleichen EAN zugewiesen. Hier wird immer der zuerst gefundene EAN genommen..
https://www.herber.de/bbs/user/24987.xls (als AktuelleRemi.xls abspeichern in c:\temp\)

Die Datei https://www.herber.de/bbs/user/24988.xls wurde aus Datenschutzgründen gelöscht

(als EAN.xls abspeichern)
Hierin ist folgendes Makro enthalten:

Private Sub Workbook_Open()
    Dim Pfad$, Scan$, LR%, TB, Sp%, EZ%, C
    '** anpassen **
    Pfad = "C:\temp\"
    Set TB = Sheets("Tabelle1")
    Sp = 1 'Spalte A
    EZ = 2 'erste Zeile
    '** ende **

Erneut:
    Scan = InputBox("Produkt scannen!" & Chr(13) & "'Abbrechen' für Ende", "Inventurerfassung")
    If Scan = "" Then
        Exit Sub
    ElseIf Len(Scan) <> 13 Then
        MsgBox "Fehleingabe"
        GoTo Erneut
    Else
        LR = TB.Cells(Rows.Count, Sp).End(xlUp).Row 'letzte Zeile der Spalte
        Set C = TB.Cells.Find(Scan, LookIn:=xlValues, LookAt:=xlWhole)
        If Not C Is Nothing Then
            C.Offset(0, 4).Value = C.Offset(0, 4).Value + 1
        Else
            Cells(LR + 1, 1).Value = Scan
            Cells(LR + 1, 2).FormulaR1C1 = _
                "=INDEX('" & Pfad & "[AktuelleRemi.xls]Tabelle1'!C1,MATCH(RC1,'" & Pfad & "[AktuelleRemi.xls]Tabelle1'!C8,1))"
            Cells(LR + 1, 3).FormulaR1C1 = _
                "=INDEX('" & Pfad & "[AktuelleRemi.xls]Tabelle1'!C3,MATCH(RC1,'" & Pfad & "[AktuelleRemi.xls]Tabelle1'!C8,1))"
            Cells(LR + 1, 4).FormulaR1C1 = _
                "=INDEX('" & Pfad & "[AktuelleRemi.xls]Tabelle1'!C11,MATCH(RC1,'" & Pfad & "[AktuelleRemi.xls]Tabelle1'!C8,1))"
            Cells(LR + 1, 5).Value = 1
        End If
    End If
    GoTo Erneut
End Sub

Der Scanner muß so eingestellt sein, das er nach dem Scan ein CR (Enter) mitschickt
Gruß UweD
(Rückmeldung wäre schön)

Beliebteste Forumthreads (12 Monate)

2 Beiträge zum Forumthread Beiträge zu diesem Forumthread

Beliebteste Forumthreads (12 Monate)

Beliebteste Forumthreads (12 Monate)

2
Beiträge zum Forumthread

Beiträge zu diesem Forumthread