满足日期条件时记录单元格值的VBA实现求助

原代码问题分析 #

1. 条件判断冗余：同时校验d.Value与B2相等、用DateDiff比对相邻单元格日期，逻辑重复且易因单元格格式差异导致匹配失败。
2. 定时任务无防重复机制：Application.OnTime未记录任务标识，重复运行会堆积多个定时任务。
3. 未处理日期格式不兼容：若目标日期列是文本格式，直接用=比较会失效。

修正后的VBA代码 #

模块代码 #

Public NextRunTime As Date ' 全局变量存储下次运行时间，用于取消任务

Public Sub RecordDailyValue()
    Dim targetDate As Date
    Dim ws As Worksheet
    Dim matchCell As Range
    
    Set ws = ThisWorkbook.Worksheets("Sheet1") ' 替换为你的工作表名称
    targetDate = ws.Range("B2").Value ' 当前日期
    
    ' 精准查找目标日期列中匹配的单元格
    Set matchCell = ws.Range("A3:A368").Find(What:=targetDate, LookIn:=xlValues, LookAt:=xlWhole)
    
    If Not matchCell Is Nothing Then
        ' 将A1当前值写入对应行的第三列（C列）
        matchCell.Offset(0, 2).Value = ws.Range("A1").Value
    End If
    
    ' 设置次日凌晨0点0分1秒执行任务
    NextRunTime = DateAdd("d", 1, Date) + TimeValue("00:00:01")
    Application.OnTime NextRunTime, "RecordDailyValue"
End Sub

Public Sub StopRecording()
    ' 取消定时任务，避免文件关闭时报错
    On Error Resume Next
    Application.OnTime NextRunTime, "RecordDailyValue", Schedule:=False
    On Error GoTo 0
End Sub

工作簿自动启停配置 #

1. 按Alt+F11打开VBA编辑器，双击左侧的ThisWorkbook。
2. 粘贴以下代码：

Private Sub Workbook_Open()
    ' 打开文件时自动启动每日记录任务
    Call RecordDailyValue
End Sub

Private Sub Workbook_BeforeClose(Cancel As Boolean)
    ' 关闭文件时取消定时任务
    Call StopRecording
End Sub

关键注意事项 #

• 确保A3:A368列的单元格格式为日期格式：选中该列，右键选择「设置单元格格式」，在「数字」选项卡中选择对应日期类型。
• 替换代码中的"Sheet1"为你实际使用的工作表名称。
• 如需立即测试，可直接运行RecordDailyValue宏，验证A1值是否正确写入对应日期的C列单元格。

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