基于Excel和VB的条形码出入账系统 [英] Excel and Visual Basic Barcode In/Out checkout system
本文介绍了基于Excel和VB的条形码出入账系统的处理方法,对大家解决问题具有一定的参考价值,需要的朋友们下面随着小编来一起学习吧!
问题描述
我正在使用Visual Basic在Excel表格中创建一个结账系统。表格将填满一个项目的信息,每个项目都需要我们发送一个工具包。该EXCEL工作表将允许扫描条形码,当发生这种情况时,它会检查放置时间。当再次扫描该条形码时,它会在时间中加上一个。我遇到的问题是,如果第三次扫描条形码,它只会更新停机时间。
如何将其设置为已记录输入和输出时间的位置,从而转到行中的下一个空白单元格并添加条形码+new";in";或";out";time。如有任何帮助,将不胜感激!这是我使用的代码。
工作表上的代码
Private Sub Worksheet_Change(ByVal Target As Range)
If Not Intersect(Target, Me.Range("B2")) Is Nothing Then
Application.EnableEvents = False
Call inout
Application.EnableEvents = True
End If
End Sub
宏的代码
Sub inout()
Dim barcode As String
Dim rng As Range
Dim rownumber As Long
barcode = Worksheets("Sheet1").Cells(2, 2)
Set rng = Sheet1.Columns("a:a").Find(What:=barcode, _
LookIn:=xlFormulas, LookAt:=xlWhole, SearchOrder:=xlByRows, _
SearchDirection:=xlNext, MatchCase:=False, SearchFormat:=False)
If rng Is Nothing Then
ActiveSheet.Columns("a:a").Find("").Select
ActiveCell.Value = barcode
ActiveCell.Offset(0, 1).Select
ActiveCell.Value = Date & " " & Time
ActiveCell.NumberFormat = "m/d/yyyy h:mm AM/PM"
Worksheets("Sheet1").Cells(2, 2) = ""
Else
rownumber = rng.Row
Worksheets("Sheet1").Cells(rownumber, 1).Select
ActiveCell.Offset(0, 2).Select
ActiveCell.Value = Date & " " & Time
ActiveCell.NumberFormat = "m/d/yyyy h:mm AM/PM"
Worksheets("Sheet1").Cells(2, 2) = ""
End If
Worksheets("Sheet1").Cells(2, 2).Select
End Sub
推荐答案
所有这些都放在工作表代码模块中:
Option Explicit
Private Sub Worksheet_Change(ByVal Target As Range)
If Not Intersect(Target, Me.Range("B2")) Is Nothing Then
inout 'use of Call is deprecated
End If
End Sub
Sub inout()
Dim barcode As String
Dim rng As Range
Dim newRow As Boolean
barcode = Me.Cells(2, 2)
'find the *last* instance of `barcode` in ColA
Set rng = Me.Columns("A").Find(What:=barcode, after:=Me.Range("A1"), _
LookIn:=xlFormulas, LookAt:=xlWhole, SearchOrder:=xlByRows, _
SearchDirection:=xlPrevious, MatchCase:=False, SearchFormat:=False)
'figure out if we need to add a new row, or update an existing one
If rng Is Nothing Then
newRow = True 'no matching barcode
Else
'does the last match already have an "in" timestamp?
If Len(rng.Offset(0, 2).Value) > 0 Then newRow = True
End If
If newRow Then
Set rng = Me.Cells(Me.Rows.Count, "A").End(xlUp).Offset(1, 0)
rng.Value = barcode
SetTime rng.Offset(0, 1) 'new row, so set "out"
Else
SetTime rng.Offset(0, 2) 'existing row so set "in"
End If
Me.Cells(2, 2).Select
End Sub
'set cell numberformat and set value to current time
Sub SetTime(c As Range)
With c
.NumberFormat = "m/d/yyyy h:mm AM/PM"
.Value = Now
End With
End Sub
这篇关于基于Excel和VB的条形码出入账系统的文章就介绍到这了,希望我们推荐的答案对大家有所帮助,也希望大家多多支持IT屋!
查看全文