excel库存代码来计算回报

我不是一个VBA专家，但我正在使用条形码扫描仪使用Excel的临时库存控制。 我目前正在使用下面的代码（我从这里从数量macrosexcel库存 ），以在工作表上添加数量，例如。 barcodeA扫描3x将自动在我的工作表中注册为3个。 我需要一种方法来减less数量。 我想要适用的条件：

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

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

 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 

Answer 1

@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 

Answer 2

试试这个：

 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 

请记住，此解决scheme不会检查产品数量是否高于零，然后删除。 所以，金额可以低于零。