Excel工作簿打开时试剂过期/即将过期弹窗提醒需求及代码优化

原代码存在的问题 #

• 定义了rReagents和rExpiration变量但未实际调用，属于冗余代码
• 循环起始行设为2，与实际数据起始行（第4行）不符，会遍历无效行
• 过期判断逻辑错误：仅匹配恰好7天后过期和恰好当天过期的试剂，无法覆盖7天内（含当天）及已过期的所有情况
• 每匹配一个试剂就弹出一个对话框，用户体验差
• 未限定工作表就使用Range，可能导致引用错误工作表的单元格

修正后的代码 #

Private Sub Workbook_Open()
    Dim ws As Worksheet
    Dim lastRow As Long, i As Long
    Dim alertMsg As String
    
    ' 指定目标工作表
    Set ws = ThisWorkbook.Worksheets("Reagent-Equipment")
    ' 获取A列最后一行数据的行号（动态适配所有试剂）
    lastRow = ws.Cells(ws.Rows.Count, "A").End(xlUp).Row
    
    ' 初始化提醒消息
    alertMsg = "试剂过期提醒：" & vbCrLf & vbCrLf
    
    ' 遍历所有试剂行（从第4行开始，对应表头下方的实际数据）
    For i = 4 To lastRow
        ' 跳过空行并验证日期有效性
        If ws.Cells(i, "A").Value <> "" And IsDate(ws.Cells(i, "C").Value) Then
            Dim expDate As Date
            expDate = ws.Cells(i, "C").Value
            
            ' 判断已过期或7天内过期的情况
            If expDate <= Date Then
                alertMsg = alertMsg & "- 已过期：" & ws.Cells(i, "A").Value & "（过期日期：" & Format(expDate, "yyyy/mm/dd") & "）" & vbCrLf
            ElseIf expDate <= Date + 7 Then
                alertMsg = alertMsg & "- 7天内过期：" & ws.Cells(i, "A").Value & "（过期日期：" & Format(expDate, "yyyy/mm/dd") & "）" & vbCrLf
            End If
        End If
    Next i
    
    ' 有提醒内容才弹窗
    If alertMsg <> "试剂过期提醒：" & vbCrLf & vbCrLf Then
        MsgBox alertMsg, vbInformation, "过期试剂通知"
    End If
End Sub

代码说明 #

• 动态覆盖所有试剂：通过lastRow自动获取A列最后一行数据，无需固定范围，适配新增的试剂条目
• 精准判断逻辑：
  • 已过期：过期日期≤当前日期
  • 7天内过期：过期日期>当前日期且≤当前日期+7
• 优化体验：将所有提醒内容汇总后一次性弹出，避免多次弹窗干扰
• 容错处理：跳过空行，同时验证过期日期列是否为有效日期，防止运行报错
• 明确引用：使用ThisWorkbook.Worksheets确保引用当前工作簿的目标工作表，避免跨表错误

使用方法 #

1. 打开Excel工作簿，按Alt + F11打开VBA编辑器
2. 在左侧项目窗口中找到ThisWorkbook，双击打开代码窗口
3. 将上述代码粘贴到窗口中
4. 保存工作簿（需选择.xlsm或.xlsb格式，支持宏运行）

内容的提问来源于stack exchange，提问作者smithalysia92