按日期为操作添加每日重置序号的Excel问题求助

需求说明 #

为表格中每个日期下的操作添加序号，每个新日期的序号从1开始重置，且支持日期列存在合并单元格的场景（公式方法无法处理合并单元格问题）。

VBA宏代码 #

Sub ResetSerialByDate()
    Dim ws As Worksheet
    Dim lastRow As Long
    Dim currentDate As Variant
    Dim serialNum As Integer
    Dim i As Long
    
    ' 指定目标工作表，可修改为具体表名，例如Set ws = ThisWorkbook.Worksheets("操作记录表")
    Set ws = ActiveSheet
    
    ' 获取A列最后一行数据行号
    lastRow = ws.Cells(ws.Rows.Count, "A").End(xlUp).Row
    
    ' 初始化变量
    currentDate = ""
    serialNum = 0
    
    ' 从第2行开始遍历（假设第1行为表头）
    For i = 2 To lastRow
        ' 处理合并单元格，获取当前行对应的日期值
        If ws.Cells(i, "A").MergeCells Then
            currentDate = ws.Cells(i, "A").MergeArea.Cells(1, 1).Value
        Else
            currentDate = ws.Cells(i, "A").Value
        End If
        
        ' 对比上一行日期，重置或递增序号
        If i = 2 Then
            serialNum = 1
        Else
            Dim prevDate As Variant
            If ws.Cells(i - 1, "A").MergeCells Then
                prevDate = ws.Cells(i - 1, "A").MergeArea.Cells(1, 1).Value
            Else
                prevDate = ws.Cells(i - 1, "A").Value
            End If
            
            If currentDate <> prevDate Then
                serialNum = 1
            Else
                serialNum = serialNum + 1
            End If
        End If
        
        ' 将序号写入B列（序号列）
        ws.Cells(i, "B").Value = serialNum
    Next i
End Sub

使用步骤 #

1. 打开目标Excel文件，按下Alt + F11打开VBA编辑器
2. 右键点击工程窗口中的工作簿名称 → 选择「插入」→「模块」
3. 将上述代码粘贴到新建的模块中
4. 返回Excel界面，按下Alt + F8，选中ResetSerialByDate宏并执行

代码说明 #

• 自动兼容日期列的合并单元格，通过MergeArea获取合并区域的真实日期值
• 遍历过程中自动对比当前行与上一行的日期，不同日期则重置序号为1，相同则序号递增
• 序号默认写入B列，若你的序号列不是B列，修改代码中ws.Cells(i, "B")的列标即可

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