时间戳

首页 > 解决方案 > 使用 VBA 在 Excel 中扫描时，将扫描的值从一个单元格移动到一个范围内的另一个单元格

vba - 使用 VBA 在 Excel 中扫描时，将扫描的值从一个单元格移动到一个范围内的另一个单元格

问题描述

我有一个电子表格在工作，看起来像这样： 工作表示例

带有标题的列中有订单号，表示该订单在生产车间所处的流程。无论处于何种流程，这些订单都会从订单表上的条形码扫描到一个单元格中。我想在扫描这些订单时从一个单元格到另一个单元格进行扫描。例如，在“GTOZ 741”列下的单元格“D4”中有一个订单号 C8VLZ70010000，如果该订单从 GTOZ 741 移动到任何其他进程，并且我将相同的订单号扫描到工作表中的任何其他单元格，我当我扫描到另一个单元格时，希望清除旧位置（“D4”）。这似乎应该在工作表周围移动一个订单号而没有任何重复。

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

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

订单号也可能位于具有填充颜色的单元格中，该填充颜色表示订单的特定内容，例如其发货方法，并且希望在订单移动时随订单移动填充颜色。如果有人能告诉我如何使用订单号扫描来处理事情，我可能会自己弄清楚单元格颜色的变化。但是，如果您也选择包含它，那将是一个巨大的帮助！我很感激任何答案，谢谢。

标签： vbaexcelonchangebarcode-scanner

解决方案

所以，你基本上已经写完了全部内容。我认为这将满足您的需要（我目前没有时间测试代码，如果它不起作用，请告诉我，我会修复它）：

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. 对电子表格进行更改的子例程将清除撤消堆栈。因此，如果您有一个用户打算输入“C8VLZ70010000”，但输入了“D8VLZ70010000”，并且 D8 是有效的订单号，那么它将清除之前的 D8，无法“撤消”它。现在您必须让您的用户找到 D8 所在的位置，将其放回原处，然后将 C8 重新输入到正确的单元格。
  2. 解决上述问题的一种方法是使用某种 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

_

  1. 最后，您可能还需要更改其他一些小事情。一种方法是让 myDataRng 成为工作表中的命名范围，而不是在 VBA 中硬编码地址。另一种方法是添加一项功能，该功能可识别项目所处的进程，并使用该功能在消息框中而不是其单元格地址中提醒用户。

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

PS重读您的问题，如果您从条形码扫描中获取订单号，也许不会有拼写错误？另外，如果是这样呢？你是怎么做到的？教我！:)

推荐阅读