签入-使用条形码扫描仪签出系统

Question

我正在尝试在我工作的实验室中创建一个签入/签出系统。我没有使用VBA的经验。我能够修改一些公式来使其达到我想要的目的，但是我并没有完全成功地完成我想要完成的所有步骤。

所以我想做的是使用条形码检入样品，然后在其旁边的单元格中输入日期。

我希望此公式适用于A2000，以便可以检入多个样品。我正在使用一个输入框，希望该输入框能够检测到匹配的样本并将其放置在检出列C中，然后在其旁边的单元格中放置一个日期。

我希望你们能给我任何帮助。

这是我当前正在使用的代码。

Private Sub Worksheet_Activate()

Dim myValue As Variant
Dim code As Variant
Dim matchedCell As Variant

myValue = InputBox("Please scan a barcode")
Range("A2").Value = myValue
Set NextCell = Cells(Rows.Count, "A").End(xlUp)
If NextCell.Row > 1 Then NextCell = NextCell.Offset(1, 0)
Set matchedCell = Range("a2:a2000").Find(what:=code, LookIn:=xlValues,     lookat:=xlWhole, MatchCase:=True)
If myValue = True Then Paste ("C2;C2000")
If Not matchedCell Is Nothing Then matchedCell.Offset(-1, 1).Value = Now

End Sub

Answer 1

为了增加数据安全性，我将区分签入和签出流程。 我不确定您如何从扫描仪获取代码？复制自动提示？ 无论如何，以下是我的解决方案：

1。将表转换为excel表（CTRL + T），并将其命名为“ STORE_RECORDS”，如下所示：

2。创建一个模块并粘贴以下代码：

Option Explicit

Sub Check_In()
    Dim Code As String: Code = InputBox("Please scan a barcode", "Scan procedure")
    If Code = "" Then MsgBox ("No code scanned"): Exit Sub
    Dim NbChIn As Integer: NbChIn = Application.CountIf(Range("STORE_RECORDS[CHECK-IN]"), Code)
    Dim NbChOut As Integer: NbChOut = Application.CountIf(Range("STORE_RECORDS[CHECK-OUT]"), Code)
    If NbChIn > NbChOut And NbChIn > 0 Then
        MsgBox ("This item is already Checked-In" & Chr(10) & "Please check it out and retry"): Exit Sub
    Else
        Cells(Rows.Count, 1).End(xlUp).Offset(1, 0) = Code
        Cells(Rows.Count, 1).End(xlUp).Offset(0, 1) = Now
    End If
End Sub

Sub Check_Out()
    Dim Code As String: Code = InputBox("Please scan a barcode", "Scan procedure")
    If Code = "" Then MsgBox ("No code scanned"): Exit Sub
    Dim NbChIn As Integer: NbChIn = Application.CountIf(Range("STORE_RECORDS[CHECK-IN]"), Code)
    Dim NbChOut As Integer: NbChOut = Application.CountIf(Range("STORE_RECORDS[CHECK-OUT]"), Code)
    If NbChIn = NbChOut And NbChIn > 0 Then
        MsgBox ("This item is already Checked-Out" & Chr(10) & "Please check it in and retry"): Exit Sub
    Else
        If Range("STORE_RECORDS[CHECK-IN]").Find(Code, , , xlWhole, , xlPrevious) Is Nothing Then MsgBox ("No match, ask Carlos !"): Exit Sub
        Range("STORE_RECORDS[CHECK-IN]").Find(Code, , ,xlWhole , , xlPrevious).Offset(0, 2) = Code
        Range("STORE_RECORDS[CHECK-IN]").Find(Code, , ,xlWhole , , xlPrevious).Offset(0, 3) = Now
    End If
End Sub

3。将Check-In和Check-Out按钮链接到相应的过程，您应该会很好。