1

我不是 VBA 专家，但我正在使用带有条形码扫描仪的 excel 进行临时库存控制。我目前正在使用下面的代码（我从这里为库存数量宏 excel 获取）在工作表上添加数量，例如。扫描 3 倍的条形码将自动在我的工作表中注册为 3 件。我还需要一种方法来合并减法。我想申请 ff 条件：

Cell "A1" = scan cell to add qty to inventory
Cell "B1" = scan cell to remove qty from the inventory

关于如何调整代码的任何建议？几天来我一直在努力调整，但无论我做什么似乎都不起作用。

Private Sub Worksheet_Change(ByVal Target As Range)

    Const SCAN_CELL As String = "A1"
    Const RANGE_BC As String = "A5:A500"
    Dim val, f As Range, rngCodes As Range

    If Target.Cells.Count > 1 Then Exit Sub
    If Intersect(Target, Me.Range(SCAN_CELL)) Is Nothing Then Exit Sub

    val = Trim(Target.Value)
    If Len(val) = 0 Then Exit Sub

    Set rngCodes = Me.Range(RANGE_BC)

    Set f = rngCodes.Find(val, , xlValues, xlWhole)
    If Not f Is Nothing Then
        With f.Offset(0, 1)
            .Value = .Value + 1
        End With
    Else
        Set f = rngCodes.Cells(rngCodes.Cells.Count).End(xlUp).Offset(1, 0)
        f.Value = val
        f.Offset(0, 1).Value = 1
    End If

    Application.EnableEvents = False
    Target.Value = ""
    Application.EnableEvents = True

    Target.Select

End Sub
4

2 回答 2

3

@Kazimierz 打败了我，但还是发布了这个......

Private Sub Worksheet_Change(ByVal Target As Range)

    Const SCAN_PLUS_CELL As String = "A1"
    Const SCAN_MINUS_CELL As String = "B1"

    Const RANGE_BC As String = "A5:A500"
    Dim val, f As Range, rngCodes As Range, inc, addr

    If Target.Cells.Count > 1 Then Exit Sub

    Select Case Target.Address(False, False)
        Case SCAN_PLUS_CELL: inc = 1
        Case SCAN_MINUS_CELL: inc = -1
        Case Else: Exit Sub
    End Select

    val = Trim(Target.Value)
    If Len(val) = 0 Then Exit Sub

    Set rngCodes = Me.Range(RANGE_BC)

    Set f = rngCodes.Find(val, , xlValues, xlWhole)
    If Not f Is Nothing Then
        With f.Offset(0, 1)
            .Value = .Value + inc 'should really check for 0 when decrementing
        End With
    Else
        If inc = 1 Then
            Set f = rngCodes.Cells(rngCodes.Cells.Count).End(xlUp).Offset(1, 0)
            f.Value = val
            f.Offset(0, 1).Value = 1
        Else
            MsgBox "Can't decrement inventory for '" & val & "': no match found!", _
                    vbExclamation
        End If
    End If

    Application.EnableEvents = False
    Target.Value = ""
    Application.EnableEvents = True

    Target.Select

End Sub
于 2015-06-17T06:16:10.900 回答
1

试试这个：

Private Sub Worksheet_Change(ByVal Target As Range)

    Const SCAN_CELL As String = "A1"
    Const SCAN_CELL_REMOVE As String = "B1"
    Dim intAddRemoveExit As Integer
    Const RANGE_BC As String = "A5:A500"
    Dim val, f As Range, rngCodes As Range

    If Target.Cells.Count > 1 Then Exit Sub
    If Not Intersect(Target, Me.Range(SCAN_CELL)) Is Nothing Then intAddRemoveExit = 1
    If Not Intersect(Target, Me.Range(SCAN_CELL_REMOVE)) Is Nothing Then intAddRemoveExit = -1
    If intAddRemoveExit = 0 Then Exit Sub

    val = Trim(Target.Value)
    If Len(val) = 0 Then Exit Sub

    Set rngCodes = Me.Range(RANGE_BC)

    Set f = rngCodes.Find(val, , xlValues, xlWhole)
    If Not f Is Nothing Then
        With f.Offset(0, 1)
            .Value = .Value + intAddRemoveExit
        End With
    Else
        Set f = rngCodes.Cells(rngCodes.Cells.Count).End(xlUp).Offset(1, 0)
        f.Value = val
        f.Offset(0, 1).Value = 1
    End If

    Application.EnableEvents = False
    Target.Value = ""
    Application.EnableEvents = True

    Target.Select

End Sub

请记住，此解决方案不会在移除前检查产品数量是否高于零。因此，金额可能会低于零。

于 2015-06-17T06:05:34.137 回答