バーコードリーダーがキーボードケーブルに「ティー」されており、つまり、キーストロークをPCに送信していると思います。Excelカーソルがワークシートの5番目の列(2番目の終了条件)にある限り、VBAコードはカーソルの右側のセル1と2(つまり列F..G)に日付と時刻を追加します。各ショット。
Worksheet_Changeトリガーが起動したときのカーソルの位置に関係なく、ワークシートの2番目と3番目の列(つまり、列B..C)に日付と時刻を配置する場合は、代わりにこのコードを使用する必要があります。
Target.EntireRow.Cells(1, 2).Value = Date
Target.EntireRow.Cells(1, 3).Value = Time
ここで...別のExcelテーブルでキャプチャされたバーコードを検索し、一致するシリアル番号を見つけるのは、日付の横のセルに自動的に貼り付けることができるVLOOKUP関数と同じくらい簡単です。または、Do...Whileを使用できます。 ..(名前付き)範囲をスキャンするためのループ構造:
....
Target(1, 4) = SernoByBarcode(Target)
....
と
Private Function SernoByBarcode(Barcode As String) As String
Dim DBase As Range, Idx As Long
Set DBase = Range("Database") ' named range "Database" contains Barcode in column1, SerNo in column2
Idx = 2 'first row contains headers
SernoByBarcode = "#NOT/FOUND" ' default return value
Do While DBase(Idx, 1) <> "" ' break on 1st empty record
If DBase(Idx, 1) = Barcode Then
SernoByBarcode = DBase(Idx, 2)
Exit Function
End If
Idx = Idx + 1
Loop
End Function
日付と時刻を設定する前にFunctionSernoByBarcodeを呼び出すと、もう1つのIFステートメントを使用して、出力形式(つまり、シリアル番号を含む/含まない)を決定できます。
編集
バーコードが常に同じセルでスキャンされるようにします(私はB2を選択しました)バーコードの存在について列5から始まるスキャンリスト...はいの場合は8/9/10に書き込み、それ以外の場合は5/6/7...検索機能は次の場合にのみ使用できます少し変更し、文字列値ではなく行インデックスを返すようになりました
Private Sub Worksheet_Change(ByVal Target As Range)
' Barcode always scanned into cell B2
' if barcode found in column 5, fill column 8,9,10 else fill columns 5,6,7
' row 1, columns 5..10 contain column headers
Dim Idx As Long
If Target.Row = 2 And Target.Column = 2 Then
Application.EnableEvents = False
Idx = FindBarcode(Target.Value)
If Me.Cells(Idx, 5) = "" Then
Me.Cells(Idx, 5) = Target.Value
Me.Cells(Idx, 6) = Date
Me.Cells(Idx, 7) = Time
Else
Me.Cells(Idx, 8) = Target.Value
Me.Cells(Idx, 9) = Date
Me.Cells(Idx, 10) = Time
End If
' keep cursor in Scan field
Me.Cells(2, 2).Select
Application.EnableEvents = True
End If
End Sub
Private Function FindBarcode(Barcode As String) As Long
Dim DBase As Range, Idx As Long
Set DBase = ActiveSheet.[E1] ' start of table
Idx = 2 'first row contains headers
Do While DBase(Idx, 1) <> "" ' break on 1st empty record
If DBase(Idx, 1) = Barcode Then
Exit Do
End If
Idx = Idx + 1
Loop
FindBarcode = Idx
End Function