先看看界面
首页
数据库
已售数据库
信息录入
功能介绍：
根据录入的商品信息，查询是否过期。盘存后点击过期日期，将已售罄商品信息保存到已售数据库中并删除数据库中信息。
代码：
ThisWorkbook
Private Sub Workbook_BeforeClose(Cancel As Boolean)Call clear_ClickActiveWorkbook.Save
End SubUserForm1
Private Sub btn_tj_Click()Application.ScreenUpdating = False '关闭屏幕刷新Dim n%Dim ctltxt_pch.Value = txt_txm.Value & "-" & txt_scrq.ValueIf Not Sheets("Data").[A:A].Find(txt_pch.Value) Is Nothing ThenMsgBox "该批次号商品已存在！"Elsen = Sheets("Data").[A65536].End(xlUp).Row + 1With Sheets("Data").Cells(n, "A").Value = txt_pch.Value '批次号.Cells(n, "B").Value = txt_txm.Value '条形码.Cells(n, "C").Value = txt_spmc.Value '商品名称.Cells(n, "D").Value = txt_sl.Value '数量.Cells(n, "E").Value = txt_jhsj.Value '进货时间.Cells(n, "F").Value = txt_scrq.Value '生产日期.Cells(n, "G").Value = txt_bzq.Value '保质期.Cells(n, "H").Value = txt_gqrq.Value '过期时间.Cells(n, "I").Value = txt_txts.Value '提醒天数.Cells(n, "J").Value = txt_txrq.Value '提醒日期End WithMsgBox "商品信息已添加！"ActiveWorkbook.SaveApplication.ScreenUpdating = True '开启屏幕刷新End IfFor Each ctl In Me.ControlsIf ctl.Name Like "txt*" Then'MsgBox c.Namectl.Text = ""End IfNextMe.txt_txm.SetFocusEnd SubPrivate Sub txt_bzq_Exit(ByVal Cancel As MSForms.ReturnBoolean)Dim scrq, gqrqIf Me.txt_bzq <> "" And IsNumeric(Me.txt_bzq) Thenscrq = Left(Me.txt_scrq, 4) & "/" & Mid(Me.txt_scrq, 5, 2) & "/" & Right(Me.txt_scrq, 2)gqrq = DateAdd("d", Me.txt_bzq, scrq)Me.txt_gqrq = Format(gqrq, "YYYYMMDD")ElseMsgBox "保质期必须为数字！"Cancel = TrueMe.txt_bzq = ""Me.txt_bzq.SetFocusEnd IfEnd SubPrivate Sub txt_scrq_Exit(ByVal Cancel As MSForms.ReturnBoolean)Dim scrq, gqrqscrq = Left(Me.txt_scrq, 4) & "/" & Mid(Me.txt_scrq, 5, 2) & "/" & Right(Me.txt_scrq, 2)If IsDate(scrq) And Len(Me.txt_scrq) = 8 ThenMe.txt_pch = Me.txt_txm & "-" & Me.txt_scrqElseMsgBox "日期格式错误！"Cancel = TrueMe.txt_scrq = ""Me.txt_scrq.SetFocusEnd IfEnd SubPrivate Sub txt_txts_Exit(ByVal Cancel As MSForms.ReturnBoolean)Dim gqrq, txrq, txtsgqrq = Left(Me.txt_gqrq, 4) & "/" & Mid(Me.txt_gqrq, 5, 2) & "/" & Right(Me.txt_gqrq, 2)If IsNumeric(Me.txt_txts) = False ThenMsgBox "提醒天数必须是数字！"Cancel = TrueMe.txt_txts = ""Me.txt_txts.SetFocusElseIf IsDate(gqrq) And Len(Me.txt_gqrq) = 8 Thentxts = CInt(Me.txt_txts) * -1txrq = DateAdd("d", txts, gqrq)Me.txt_txrq = Format(txrq, "YYYYMMDD")ElseMsgBox "日期格式错误！"Cancel = TrueMe.txt_scrq = ""Me.txt_scrq.SetFocusEnd IfEnd Sub
模块1
Sub add_Click()Worksheets("Data").ActivateWorksheets("Data").SelectUserForm1.Show
End SubSub query_Click()Call clear_ClickDim n%, i%, txrq, y, m, d 'txrq提醒日期Application.ScreenUpdating = False '关闭屏幕刷新'MsgBox Format(Now(), "YYYY年" & "MM月" & "DD日")n = Sheets("Data").Range("J" & Rows.Count).End(xlUp).Row '获取表 Data J列最大行数'MsgBox nFor i = n To 2 Step -1txrq = Sheets("Data").Cells(i, "J")y = Left(txrq, 4)m = Mid(txrq, 5, 2)d = Right(txrq, 2)txrq = DateSerial(y, m, d)If Now() > txrq ThenSheets("Main").Rows(6).InsertSheets("Data").Rows(i).Copy Sheets("Main").Rows(6)End IfNext iApplication.ScreenUpdating = True '开启屏幕刷新Range("A1").Select
End SubSub clear_Click()Dim n%Application.ScreenUpdating = False '关闭屏幕刷新n = Sheets("Main").[A65536].End(xlUp).Row '获取最大数据行数If n > 5 Then Range(Rows(6), Rows(n)).Delete '删除第6行到最大数据行Application.ScreenUpdating = True '开启屏幕刷新
End Sub
