0

バーコード リーダーを使用して 1 つのセルにシリアル番号を入力し、次を使用して次の 2 つのセルに日付と時刻を自動的に追加しています。

Private Sub Worksheet_Change(ByVal Target As Range)
If Target.Cells.Count > 5 Then Exit Sub
If Target.Column <> 5 Then Exit Sub
Application.EnableEvents = False
Target(1, 2).Value = Date
Target(1, 3).Value = Time
Application.EnableEvents = True
End Sub

バーコードをスキャンして、シリアル番号を自動的に見つけて、2 つの「他のセル 4 & 5」に日時スタンプを配置するか、そのシリアル番号がセルにない場合は、そこに日付時刻を入れます。 2 & 3 セル。

4

1 に答える 1

1

バーコードリーダーがキーボードケーブルに「ティー」されており、つまり、キーストロークを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
于 2012-08-20T17:01:55.233 に答える