Question

我有一个工作表，如下所示：

在带有标题的列中有订单号，表示该订单位于生产车间的流程。这些订单将从订单上的条形码扫描到处于任何处理过程的单元格中。我想在扫描顺序时逐个扫描这些顺序。例如，在“ GTOZ 741”列下的“ D4”单元格中有一个订单号C8VLZ70010000，如果该订单从GTOZ 741转移到任何其他进程，并且我将该相同的订单号扫描到工作表中的任何其他单元格，希望在我扫描到其他单元格时清除旧位置（“ D4”）。看来这应该在工作表中移动一个订单号，而没有任何重复。

与此同时，我拥有的是一个on change例程，该例程标识重复的值并将字体颜色更改为红色。然后，当用户手动删除较早的条目时，字体将变回黑色。该代码如下所示：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

订单号也可能位于具有填充颜色的单元格中，该颜色表示特定于订单的某些内容（例如其发运方法），并希望随订单移动填充颜色。如果有人可以告诉我如何使订单号扫描工作正常，那么我可能可以自己弄清楚单元颜色的移动。但是，如果您选择也包括在内，那将是巨大的帮助！感谢您的回答，谢谢。

Answer 1

因此，您基本上已经编写了全部内容。我认为这可以满足您的需要（目前我没有时间测试代码，如果它无法正常工作，请告诉我，我会对其进行修复）：

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

不过，有几件事：

对电子表格进行更改的子例程将清除撤消堆栈。因此，如果您有一个用户要输入“ C8VLZ70010000”，而输入的是“ D8VLZ70010000”，并且D8是有效的订单号，则它将清除较早的D8，而无法“撤消”该命令。现在，您必须让用户找到D8的位置，放回D8，然后将C8重新输入到正确的单元格中。
解决上述问题的一种方法是让某种类型的msgbox警告用户。然后，他们可以说“确定”以继续更改，或者说“取消”以退出子项。像这样：

_

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

_

最后，您可能还需要更改其他一些小事项。一种可能是使myDataRng成为工作表中的命名范围，而不是而不是在VBA中对地址进行硬编码。另一个可能是添加一个标识项目处于哪个流程并将其用于的功能在您的消息框中提醒用户，而不是其单元格地址。

让我知道您是否有疑问。

P.S。重新阅读您的问题，如果您从条形码扫描中获取订单号，也许不会出现错别字？另外，如果是这样的话？你最近怎么样教我！：）

使用VBA

1 个答案: