使用 VBA 在 excel 中扫描时,将扫描值从一个单元格移动到另一个单元格

Move scanned values from one cell to another in a range as they are scanned in excel using VBA

我的作品sheet 看起来像这样:

带有 headers 的列中有订单号,表示该订单在生产车间的流程。这些订单从订单 sheet 上的条形码扫描到处于任何进程的单元格中。我想在扫描这些订单时逐个扫描这些订单。例如,在 "GTOZ 741" 列下的单元格 "D4" 中有一个订单号 C8VLZ70010000,如果该订单从 GTOZ 741 移动到任何其他进程并且我将相同的订单号扫描到sheet,我希望在扫描到另一个单元格时清除旧位置("D4")。这似乎应该在工作中移动一个订单号sheet 而没有任何重复。

与此同时,我拥有的是一个更改例程,它识别重复值并将字体颜色更改为红色。然后当用户手动删除较早的条目时,字体变回黑色。 该代码如下所示:Code Example

Private Sub Worksheet_Change(ByVal Target As Range)
    On Error GoTo ErrHandler
    Application.ScreenUpdating = False

    Dim myDataRng As Range
    Dim cell As Range

    ' WE WILL SET THE RANGE (SECOND COLUMN).
    Set myDataRng = Range("A1:J34")

    For Each cell In myDataRng
        cell.Offset(0, 0).Font.Color = vbBlack          ' DEFAULT COLOR.

        ' LOCATE DUPLICATE VALUE(S) IN THE SPECIFIED.
        If Application.Evaluate("COUNTIF(" & myDataRng.Address & "," & cell.Address & ")") > 1 Then
            cell.Offset(0, 0).Font.Color = vbRed        ' CHANGE COLOR TO RED.
        End If
    Next cell

    Set myDataRng = Nothing
    ErrHandler:
    Application.EnableEvents = True
    Application.ScreenUpdating = True
End Sub

订单号也可能位于具有填充颜色的单元格中,该填充颜色表示有关订单的某些特定内容,例如其运送方法,并且如果订单移动,则希望随订单一起移动填充颜色。如果有人能告诉我如何使用订单号扫描,我可能会自己弄清楚单元格颜色的移动。但是,如果您也选择包括它,那将是一个巨大的帮助!我感谢任何答案,谢谢。

所以,你基本上已经写好了所有的东西。我认为这会满足您的需要(我目前没有时间测试代码,如果它不起作用请告诉我,我会修复它):

Private Sub Worksheet_Change(ByVal Target As Range)
    On Error GoTo ErrHandler
    Application.ScreenUpdating = False

    Dim myDataRng As Range
    Dim cell As Range

    'Define and set the order number and address that just changed
    Dim orderNumber As String, orderNumberAddress
    orderNumberAddress = Target.Address
    orderNumber = Target.Value2
    'If a cell is cleared of its contents, no need to check for blanks
    If orderNumber = "" Then
        Exit Sub
    End if

    ' WE WILL SET THE RANGE (SECOND COLUMN).
    Set myDataRng = Range("A1:J34")

    'make it so our event doesn't trigger itself
    Application.EnableEvents = False

    For Each cell In myDataRng
        'if the value of the cell is the same as the value of the cell that just changed,
        'AND the cell is NOT the cell that just changed
        If cell.Value2 = orderNumber And cell.Address <> orderNumberAddress Then
            cell.ClearContents
            'set the new order number cell's colorindex to match
            Target.Interior.ColorIndex = cell.Interior.ColorIndex
            'default fill color
            cell.Interior.ColorIndex = -4142
        End If
    Next

    'Not really necessary, as myDataRng goes out of scope upon completion of the subroutine
    'Set myDataRng = Nothing
ErrHandler:
    Application.EnableEvents = True
    Application.ScreenUpdating = True
End Sub

不过有几点:

  1. 对传播进行更改的子例程sheet 将清除撤消堆栈。因此,如果您有一个用户本想输入 'C8VLZ70010000' 但输入了 'D8VLZ70010000',并且 D8 是一个有效的订单号,那么它将清除较早的 D8,而无法 "undo"那。现在您必须让您的用户找到 D8 的位置,将其放回原处,然后将 C8 重新输入到正确的单元格。
  2. 解决上述问题的一种方法是使用某种消息框警告用户。然后他们可以说 "ok" 继续更改,或者说 "cancel" 退出 sub。像这样:

_

Dim response As Long
response = MsgBox("Found " & orderNumber & " in cell " & cell.Address & ". OK to delete?", vbOKCancel, "Order Found")
If response = vbOK Then
    'do stuff
Else
    GoTo ErrHandler
End If

_

  1. 最后,还有一些您可能想要更改的小事情。 一种方法是使 myDataRng 成为 sheet 中的命名范围 而不是在 VBA 中硬编码地址。另一个是添加一个 标识项目所处流程的功能,并使用它来 在您的消息框中提醒用户而不是其手机地址。

如果您有任何问题,请告诉我。

P.S。重读你的问题,如果你从条形码扫描中获取订单号,也许不会有错别字?另外,如果是这样呢?你是怎么做到的?教我! :)