如何修改Excel VBA代码实现A列写入后C列数值随天数递增？

要实现这个需求，核心是记录C列初始设为0的日期，通过计算当前日期与初始日期的天数差，自动更新C列数值。以下是具体步骤和修改后的代码：

步骤说明 #

1. 新增辅助列（比如D列）：用来存储C列被设为0的初始日期，作为计算天数差的依据。
2. 修改原Worksheet_Change事件：当A列输入内容时，除了设置C列为0，同时把当前日期写入对应D列单元格。
3. 编写更新子程序：遍历目标区域，根据初始日期和当前日期的差值更新C列数值。
4. 设置触发时机：让更新子程序在工作簿打开、工作表激活时自动执行，确保数值始终是最新的。

修改后的完整代码 #

替换原有的Worksheet_Change事件代码，同时添加两个新的事件过程：

Private Sub Worksheet_Change(ByVal target As Range)
    Dim cell As Range
    Dim validationRange As Range
    Dim customValue As Variant

    On Error GoTo ErrorHandler

    ' 定义数据验证的目标区域（B2:B100）
    Set validationRange = Me.Range("B2:B100")

    ' 处理B列的"Other"自定义输入
    If Not Intersect(target, validationRange) Is Nothing Then
        Application.EnableEvents = False ' 防止重复触发事件
        
        For Each cell In target
            If cell.Value = "Other" Then
                customValue = InputBox("请输入'Other'对应的自定义值：", "自定义值输入")
                
                If customValue <> "" Then
                    cell.Value = customValue
                Else
                    cell.ClearContents
                End If
            End If
        Next cell
    End If

    ' 处理A列输入：设置C列为0，同时记录初始日期到D列
    If Not Intersect(target, Me.Range("A2:A100")) Is Nothing Then
        Application.EnableEvents = False
        For Each cell In target
            If cell.Value <> "" Then
                cell.Offset(0, 2).Value = 0 ' C列设为0
                cell.Offset(0, 3).Value = Date ' D列记录当前日期
            Else
                cell.Offset(0, 2).ClearContents ' 清空C列
                cell.Offset(0, 3).ClearContents ' 清空D列
            End If
        Next cell
    End If

ExitHandler:
    Application.EnableEvents = True ' 确保事件始终重新启用
    Exit Sub

ErrorHandler:
    MsgBox "发生错误：" & Err.Description
    Resume ExitHandler
End Sub

' 工作表激活时自动更新C列数值
Private Sub Worksheet_Activate()
    UpdateCColumnValues
End Sub

' 工作簿打开时自动更新当前工作表的C列数值
Private Sub Workbook_Open()
    Sheet1.UpdateCColumnValues ' 注意：Sheet1替换成你的实际工作表名称
End Sub

' 更新C列数值的子程序
Sub UpdateCColumnValues()
    Dim ws As Worksheet
    Dim lastRow As Long
    Dim i As Long
    
    Set ws = Me ' 当前工作表
    lastRow = ws.Range("A" & ws.Rows.Count).End(xlUp).Row ' 获取A列最后一行有内容的行号
    
    Application.EnableEvents = False
    
    ' 遍历A2到最后一行
    For i = 2 To lastRow
        ' 如果A列有内容，且D列有初始日期
        If ws.Cells(i, 1).Value <> "" And IsDate(ws.Cells(i, 4).Value) Then
            ' C列值 = 当前日期与初始日期的天数差（初始为0，每过一天加1，差值即为当前应有的数值）
            ws.Cells(i, 3).Value = Date - ws.Cells(i, 4).Value
        End If
    Next i
    
    Application.EnableEvents = True
End Sub

关键部分解释 #

• 辅助列D列：cell.Offset(0, 3).Value = Date 在A列输入内容时，将当前系统日期写入D列对应单元格，作为计算的时间起点。
• 更新子程序UpdateCColumnValues：通过Date - ws.Cells(i, 4).Value计算天数差，这个差值就是C列应该递增到的数值。
• 触发时机：Worksheet_Activate确保每次切换到该工作表时自动更新；Workbook_Open确保打开工作簿时就同步最新数值。

注意事项 #

1. 把代码中的Sheet1替换成你实际的工作表名称（比如工作表叫"数据记录"，就改成Sheet("数据记录").UpdateCColumnValues）。
2. 若不需要显示D列，右键点击D列选择隐藏即可，不影响后台计算。
3. 手动触发更新可直接运行UpdateCColumnValues子程序（按F5执行）。

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