Код для инвентаря excel для подсчета возвращается

Question

Я не эксперт VBA, но я работаю над временным управлением запасами, используя excel с помощью сканера штрих-кода. В настоящее время я использую код ниже (который я взял здесь quantity macro excel for inventory), чтобы добавить qty на рабочий лист, например. barcodeA сканирует 3x автоматически регистрируется как 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 

Answer 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 

Пожалуйста, имейте в виду, что это решение не проверяет, если количество продукта выше, то перед удалением нуля. Таким образом, сумма может пойти ниже нуля.

Answer 2

@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