Hallo zusammen,
in beigefügter Liste möchte ich gerne, dass beim Scannen eines Barcodes aus dem Datenblatt "Barcodes" im Datenblatt "Eintrag"
ein Zeitstempel hinterlegt wird. Liste dazu kann fortlaufend sein.
Ausgabe =
Wert aus Barcode -> "Eintrag" Spalte A
"Eintrag" Spalte B = Zeitstempel
Nun habe ich das Problem, dass sich der Zeitstempel immer für alle Felder aktualisiert und komme nicht dahinter,
wie ich das lösen kann.
Kann mir jemand helfen? (Hoffe ihr versteht meine Schilderung)
Grüße
Kai
Hallo
- Rechtsclick auf den Tabellenblattreiter
- Code anzeigen
- Code rechts reinkopieren
dann...
- markiere auf Blatt "Eintrag" Spalte A:B
- Rechtsclick; Zellen formatieren
- unter Schutz den Haken raus
- Rechtsclick auf den Tabellenblattreiter
- Blatt schützen; Haken bei "Gesperrte Zellen auswählen" rausnehmen; OK
- A2 auswählen und scannen
Code:
Option Explicit
Private Sub Worksheet_Change(ByVal Target As Range)
On Error GoTo Fehler
Const APPNAME = "Worksheet_Change"
If Not Intersect(Range("A:A"), Target) Is Nothing Then
If Target.Count > 1 Then
MsgBox "Zellen nur einzeln bearbeiten", vbOKOnly
With Application
.EnableEvents = False
.Undo
End With
Exit Sub
End If
If Target <> "" Then
Application.EnableEvents = False
Target.Offset(0, 1) = Format(Now, "YYYY.MM.DD hh:mm:ss")
Target.Offset(1, 0).Select
End If
End If
'*** Fehlerbehandlung
Err.Clear
Fehler:
Application.EnableEvents = True
If Err.Number <> 0 Then MsgBox "Fehler in Sub """ & APPNAME & """" & vbCrLf _
& "Fehlernummer: " & Err.Number & vbLf & Err.Description: Err.Clear
End Sub
LG UweD
Hallo
zusätzlich noch ein paar Prüfungen
Code:
Option Explicit
Private Sub Worksheet_Change(ByVal Target As Range)
Dim Scann As String
Dim TB1 As Worksheet, Sp As Integer
Set TB1 = Sheets("Barcodes")
Sp = 1 'Prüfung aus Spalte A
On Error GoTo Fehler
Const APPNAME = "Worksheet_Change"
If Not Intersect(Range("A:A"), Target) Is Nothing Then
If Target.Count > 1 Then
MsgBox "Zellen nur einzeln bearbeiten", vbOKOnly
With Application
.EnableEvents = False
.Undo
.EnableEvents = True
End With
Exit Sub
End If
If InStr(Target, " ") > 0 Then
Scann = Left(Target, InStr(Target, " ") - 1)
If WorksheetFunction.CountIf(TB1.Columns(Sp), Scann) > 0 Then
Application.EnableEvents = False
Target.Offset(0, 1) = Format(Now, "YYYY.MM.DD hh:mm:ss")
Target.Offset(1, 0).Select
Else
MsgBox "Artikelnummer '" & Scann & "' nicht vorhanden", vbOKOnly
With Application
.EnableEvents = False
.Undo
.EnableEvents = True
End With
End If
Else
MsgBox "Scan fehlerhaft", vbOKOnly
With Application
.EnableEvents = False
.Undo
.EnableEvents = True
End With
End If
End If
'*** Fehlerbehandlung
Err.Clear
Fehler:
Application.EnableEvents = True
If Err.Number <> 0 Then MsgBox "Fehler in Sub """ & APPNAME & """" & vbCrLf _
& "Fehlernummer: " & Err.Number & vbLf & Err.Description: Err.Clear
End Sub
LG UweD
[
attachment=37682][
attachment=37682]Moin Uwe!
Danke vielmals, erstmal macht der Code genau was ich beschrieben hatte. (Sogar etwas mehr)
Habe nun noch die Schwierigkeit, dass ich den Wert aus Spalte "A" in einem anderen Tabellenblatt
ausgeben möchte, aber NUR den Wert des letzten/aktuellsten Zeitstempels.
Da kommt mein Sverweis leider an seine Grenzen, der zeigt mir nur den ersten Wert in der Liste...
Hat nochmal jemand einen Tipp?
[
Bild bitte so als Datei hochladen: Klick mich!]
Guten Morgen zusammen!
Hat jemand eine Idee?
Hab die Datei nochmal hinzugefügt.
Wäre klasse, wenn hier jemand helfen könnte!