[EXCEL]商品保质期管理

先看看界面

首页

数据库

已售数据库

信息录入

功能介绍：

      根据录入的商品信息，查询是否过期。盘存后点击过期日期，将已售罄商品信息保存到已售数据库中并删除数据库中信息。

代码：

ThisWorkbook

Private Sub Workbook_BeforeClose(Cancel As Boolean)
    Call clear_Click
    ActiveWorkbook.Save
End Sub

UserForm1

Private Sub btn_tj_Click()
    Application.ScreenUpdating = False  '关闭屏幕刷新
    Dim n%
    Dim ctl
    txt_pch.Value = txt_txm.Value & "-" & txt_scrq.Value
    If Not Sheets("Data").[A:A].Find(txt_pch.Value) Is Nothing Then
        MsgBox "该批次号商品已存在！"
    Else
        
        n = Sheets("Data").[A65536].End(xlUp).Row + 1
        With 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 With
        MsgBox "商品信息已添加！"
        ActiveWorkbook.Save
        Application.ScreenUpdating = True   '开启屏幕刷新
    End If
    For Each ctl In Me.Controls
        If ctl.Name Like "txt*" Then
            'MsgBox c.Name
            ctl.Text = ""
        End If
    Next
    Me.txt_txm.SetFocus

End Sub

Private Sub txt_bzq_Exit(ByVal Cancel As MSForms.ReturnBoolean)
    Dim scrq, gqrq
    If Me.txt_bzq <> "" And IsNumeric(Me.txt_bzq) Then
        scrq = 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")
    Else
        MsgBox "保质期必须为数字！"
        Cancel = True
        Me.txt_bzq = ""
        Me.txt_bzq.SetFocus
    End If
    
End Sub

Private Sub txt_scrq_Exit(ByVal Cancel As MSForms.ReturnBoolean)
    
    Dim scrq, gqrq
    scrq = 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 Then
        Me.txt_pch = Me.txt_txm & "-" & Me.txt_scrq
    Else
        MsgBox "日期格式错误！"
        Cancel = True
        Me.txt_scrq = ""
        Me.txt_scrq.SetFocus
    End If

End Sub

Private Sub txt_txts_Exit(ByVal Cancel As MSForms.ReturnBoolean)
    Dim gqrq, txrq, txts
    gqrq = Left(Me.txt_gqrq, 4) & "/" & Mid(Me.txt_gqrq, 5, 2) & "/" & Right(Me.txt_gqrq, 2)
    If IsNumeric(Me.txt_txts) = False Then
        MsgBox "提醒天数必须是数字！"
        Cancel = True
        Me.txt_txts = ""
        Me.txt_txts.SetFocus
    ElseIf IsDate(gqrq) And Len(Me.txt_gqrq) = 8 Then
        txts = CInt(Me.txt_txts) * -1
        txrq = DateAdd("d", txts, gqrq)
        Me.txt_txrq = Format(txrq, "YYYYMMDD")
    Else
        MsgBox "日期格式错误！"
        Cancel = True
        Me.txt_scrq = ""
        Me.txt_scrq.SetFocus
    End If

End Sub

模块1

Sub add_Click()
    Worksheets("Data").Activate
    Worksheets("Data").Select
    UserForm1.Show
End Sub

Sub query_Click()
    Call clear_Click
    Dim 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 n
    For i = n To 2 Step -1
        txrq = 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 Then
            Sheets("Main").Rows(6).Insert
            Sheets("Data").Rows(i).Copy Sheets("Main").Rows(6)
        End If
    Next i
    Application.ScreenUpdating = True   '开启屏幕刷新
    Range("A1").Select
End Sub

Sub 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