工作簿打开时根据到期日期弹出警报

Question

我希望在试剂 7 天后过期、试剂过期、工作簿打开时弹出消息警报。

消息应包含过期的试剂。我尝试对“FA 试剂”(A4:A20) 和这些试剂的有效期 (C4:C20) 进行此操作。最终我希望代码适用于本表中的所有试剂。

Excel表格

Private Sub Workbook_Open()
    Dim ws As Worksheet
    Dim rReagents As Range
    Set rReagents = Range("A4:A20")
    Dim rExpiration As Range
    Set rExpiration = Range("C4:C20")
    Dim lLastrow As Long, i As Long
    Set ws = Worksheets("Reagent-Equipment")
    lLastrow = ws.Cells(ws.Rows.Count, 1).End(xlUp).Row
    With ws
        For i = 2 To lLastrow
            If .Cells(i, 2) = Date + 7 Then MsgBox ("Reagent expiring in 7 days for " & .Cells(i, 1))
            If .Cells(i, 2) = Date Then MsgBox ("Reagent expiring today for " & .Cells(i, 1))
        Next
    End With
End Sub

Answer 1

您可能会发现以下感兴趣的代码

Private Sub Workbook_Open()

    Dim myShortDate As String
    Dim myExpired As String
    Dim ws As Worksheet
    Set ws = Worksheets("Reagent-Equipment")
    
    
    Dim myReagents As Variant
    myReagents = Application.WorksheetFunction.Transpose(ws.Range("A4:A20").Value)
    
    Dim myExpiry As Variant
    myExpiry = Application.WorksheetFunction.Transpose(ws.Range("C4:C20").Value)
   
  
    Dim myIndex As Long
    myIndex = 1
    Dim myItem As Variant
    For Each myItem In myReagents
    
        If Now > VBA.CDate(myExpiry(myIndex)) Then
        
            If VBA.Len(myExpired) = 0 Then
                
                myExpired = vbTab & myReagents(myIndex)
            
            Else
            
                myExpired = myExpired & vbCrLf & vbTab & myReagents(myIndex)
                
            End If
        
        ElseIf Now + 7 > VBA.CDate(myExpiry(myIndex)) Then
        
            If VBA.Len(myShortDate) = 0 Then
                
                myShortDate = vbTab & myReagents(myIndex) & " on " & myExpiry(myIndex)
            
            Else
            
                myShortDate = myShortDate & vbCrLf & vbTab & myReagents(myIndex) & " on " & myExpiry(myIndex)
                
            End If
            
        End If
    
        myIndex = myIndex + 1
        
    Next
    
    If VBA.Len(myExpired) > 0 Then
    
        myExpired = "Expired Reagents" & vbCrLf & vbCrLf & myExpired & vbCrLf & vbCrLf
        
    End If
    
    
    If VBA.Len(myShortDate) > 0 Then
    
        myShortDate = "Reagents due to expire " & vbCrLf & vbCrLf & myShortDate & vbCrLf & vbCrLf
        
    End If
    
    Dim myMessage As String
    myMessage = myExpired & myShortDate
    
    If VBA.Len(myMessage) > 0 Then
    
        MsgBox myMessage, vbCritical
        
    End If
    

End Sub