In/Out 工具跟踪编码,不重复,文本总是被添加到条形码扫描仪输入的文本中,而不是被删除的文本

Coding for In/Out Tracking of Tools with no repeating and text always getting added into and not deleted text input by barcode scanner

我正在尝试在 Microsoft Excel 中编写一个代码,当另一个单元格被填充时,它将文本放入一个单元格。

我正在寻找的是,例如,当单元格 A 被填充时,单元格 C 被填充为 OUT。然后当单元格A在下一行或它下面的另一行再次填充时,与单元格A在同一行的单元格C用IN填充。

我们想使用条形码扫描仪来检查进出工具。我已经想出了如何让条形码扫描到 A 列

我希望这个过程一遍又一遍地重复。

它应该是跟踪 sheet 工具何时取出并放回库存。文本将不断添加,不会删除任何内容。我们想使用条形码扫描器来检查工具的进出。员工扫描指示他们的条形码,然后扫描工具指示他们正在使用的工具。然后,当他们回来时,他们会再次扫描条形码,然后将工具扫描回库存中。当然,仅仅拥有这个简单的设置会导致工具是否进出以及谁最后使用它的混乱,因为我们有一群员工不断地进出工具。这样我们就可以确定谁最后使用了什么工具,以及它是 IN 还是 OUT。

下面是时间戳所需的编码。

Private Sub Worksheet_Change(ByVal Target As Range)
Dim B As Range, AC As Range, t As Range

Set B = Range("B:B")
Set AC = Range("A:A")
Set t = Target

If Intersect(t, AC) Is Nothing Then Exit Sub

Application.EnableEvents = False
Range("B" & t.Row).Value = Now
Application.EnableEvents = True
End Sub

您可以使用工作表 'IF()' 公式代替 VBA。

=IF(A3="","","OUT")
=IF(A4="","","IN")

分解一下,这意味着如果单元格 A3 = nothing ("") 则在单元格 C3 中不放置任何内容 (""),但如果单元格 A3 中有内容,则放置 "OUT"。

将第一个公式放在单元格 C3 中,将第二个公式放在 C4 中。如果该工具的用户在单元格 A3 中输入他们的 initials/name,则单元格 C3 将显示 OUT。直到用户回来 returns 工具并在单元格 A4 中输入他们的 initials/name 单元格 C4 才会说 IN.

希望这个简单的非 VBA 示例对您有所帮助!

这听起来像是一个非常人为的例子来问这个问题"In VBA, how do I fill an Excel cell with a specific string?"

该问题的答案是:

myRange.Value = "<myString>"

无论如何,这就是我尝试解决您的问题的方式:

Private Sub Worksheet_Change(ByVal Target As Range)

    Dim rngChange As Range
    Dim rngIntersect As Range
    Dim xlCell As Range
    Dim inOut As String

    Set rngChange = Range("A:A")
    Set rngIntersect = Intersect(Target, rngChange)

    If Not rngIntersect Is Nothing Then
        Application.EnableEvents = False
        For Each xlCell In rngIntersect

            If xlCell.Value = "" Then
                inOut = "OUT"
            Else
                inOut = "IN"
            End If


            xlCell.Offset(0, 1).Value = Now
            xlCell.Offset(0, 2).Value = inOut
        Next xlCell
        Application.EnableEvents = True
    End If

End Sub

编辑:

针对提问者的评论,修改以下代码应该可以解决问题:

Private Sub Worksheet_Change(ByVal Target As Range)

    Dim rngChange As Range
    Dim rngIntersect As Range
    Dim inOut As String

    Set rngChange = Range("A:A")
    Set rngIntersect = Intersect(Target, rngChange)

    If Not rngIntersect Is Nothing Then
        Application.EnableEvents = False

            If rngIntersect.Row = 1 Then
                inOut = "OUT"
            ElseIf rngIntersect.Offset(-1, 2).Value = "OUT" Then
                inOut = "IN"
            Else
                inOut = "OUT"
            End If


            rngIntersect.Offset(0, 1).Value = Now
            rngIntersect.Offset(0, 2).Value = inOut
        Application.EnableEvents = True
    End If

End Sub

编辑2:

使用它在您的日志中向后循环以确定特定 id 的先前预订状态:

Option Explicit
Private Sub Worksheet_Change(ByVal Target As Range)

    Dim rngChange As Range
    Dim rngIntersect As Range
    Dim xlCell As Range
    Dim scanId As String
    Dim inOutOld As String
    Dim inOut As String

    Set rngChange = Range("A:A")
    Set rngIntersect = Intersect(Target, rngChange)

    If Not rngIntersect Is Nothing Then
        Application.EnableEvents = False

            scanId = rngIntersect.Value

            Set xlCell = rngIntersect

            If rngIntersect.Row = 1 Then
                inOut = "OUT"
            Else
                Do Until xlCell.Row = 1
                    Set xlCell = xlCell.Offset(-1, 0)

                    If xlCell.Value = scanId Then
                        inOutOld = xlCell.Offset(0, 2).Value
                        Exit Do
                    End If

                Loop

            End If

            If inOutOld = "IN" Then
                inOut = "OUT"
            Else
                inOut = "IN"
            End If

            rngIntersect.Offset(0, 1).Value = Now
            rngIntersect.Offset(0, 2).Value = inOut
        Application.EnableEvents = True
    End If

End Sub