2015-06-17 101 views
1

我不是VBA專家,但我正在使用excel與條碼掃描器進行臨時庫存控制。我目前使用下面的代碼(我從這裏取得的quantity macro excel for inventory)在工作表上添加數量,例如。 barcodeA掃描3x將自動在我的工作表中註冊爲3個。我需要一種方法來合併減數量。我想ff條件適用:excel庫存代碼返回

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 

回答

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 

請記住,這個解決方案並不檢查產品的量是在刪除之前高於零。所以,金額可能會低於零。

+0

,如果我想的第一個條目被放置,而不是A5單元格B10是什麼?我會假設我只需要更改RANGE_BC選項,但它似乎不起作用? – user5018013

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 
+0

這工作就像一個魅力,謝謝! – user5018013