我不是VBA专家,但我正在使用excel和条形码扫描仪进行临时库存控制。我目前正在使用下面的代码(我从这里quantity macro excel for inventory获取)在工作表上添加数量,例如。 barcodeA扫描3x将在我的工作表中自动注册为3个。我需要一种方法来合并减去数量。我想要应用的ff条件:
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
有关如何调整代码的任何建议吗?我一直试图调整几天,但无论我做什么似乎都没有效果。
pickle
答案 0 :(得分: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
答案 1 :(得分: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
请注意,此解决方案不会在删除之前检查产品数量是否高于零。因此,金额可能会低于零。