当我们打开Excel工作簿时，如果当天有日程信息，包括当天的日期在内，就会自动弹出一个信息提示框，如果没有到期的信息，则不会显示任何提示框。看看效果：(见下图）
下面就是我们需要提醒的日程，事前输入到工作表中（如下图）
我们先建立一个模块（信息提醒），输入如下一段代码：
Sub CheckExpiration()
Dim ws As Worksheet
Dim todayDate As Date
Dim expDate As Date
Dim lastRow As Long
Dim i As Long
Dim msgText As String
Dim msgTitle As String
Dim msgNum As Integer
Set ws = ThisWorkbook.Worksheets("Sheet1")
todayDate = Date
' 获取最后一行的行号
lastRow = ws.Cells(ws.Rows.Count, "A").End(xlUp).Row
' 遍历 A 列中的每个单元格
For i = 1 To lastRow
' 检查单元格的值是否是日期，如果是，则与今天的日期进行比较
If IsDate(ws.Cells(i, 1).Value) Then
expDate = CDate(ws.Cells(i, 1).Value)
If expDate = todayDate Then
' 添加到提示文本
msgNum = msgNum + 1
If Len(msgText) > 0 Then
msgText = msgText & vbNewLine & msgNum & "、 " & ws.Cells(i, 2).Value
Else
msgText = msgText & msgNum & "、 " & ws.Cells(i, 2).Value
End If
End If
End If
Next i
' 如果有到期的信息，则显示消息框
If Len(msgText) > 0 Then
msgTitle = "今天到期的提醒信息 (" & Format(todayDate, "yyyy-mm-dd") & ")"
MsgBox msgText, vbInformation, msgTitle
End If
End Sub
再在“Workbook_Open”事件中输入如下代码，以便在打开工作簿时自动执行此代码。
Private Sub Workbook_Open()
Call CheckExpiration
End Sub
这个功能可以应用在需要定期检查某个 Excel 工作簿中某个单元格或一列中是否存在特定日期的情况下。
在这种情况下，代码将在打开 Excel 工作簿时自动运行，搜索指定的单元格或一列中是否存在与当天日期相同的日期值。如果找到了一个或多个匹配项，则会在屏幕上显示一个消息框，其中包含所有匹配项的详细信息，以便用户可以及时知道这些信息已经到期。
你可以举一返三，应用到许多场景。
例如，如果你的 Excel 工作簿用于跟踪产品保修日期，你可以将产品保修日期列保存在 Excel 工作表中，并使用上面的 VBA 代码来检查在某个特定日期是否有产品保修期已到期，以便你可以及时提醒客户进行维修或更换。这可以帮助你提高客户满意度，并为你的业务建立信任和忠诚度。
此外，此代码还可以应用于其他需要检查特定日期的 Excel 工作簿，例如保险策略到期日期、预约、合同截止日期等。
