如何在Excel多行粘贴后自动按增量为行编号？

需求背景 #

• 需将多组数据源导入Excel分析：每组数据从B列第1行起粘贴表头（列数不固定），A1手动输入该组的参考编码；每组原始数据包含多行格式一致的内容。
• 目标：替代手动在A列输入页码并向下填充的操作，通过VBA实现同一组数据对应同一页码，下一组页码自动在上一组基础上加1，如第5组9行数据均标记5，第6组25行均标记6。

现有代码问题 #

当前代码仅支持首次粘贴数据时A列填充1，后续粘贴新数据组到上组末尾下方时，A列仍填充1，未实现页码递增。

修改后的VBA代码 #

Private Sub Worksheet_Change(ByVal Target As Range)
    Dim rng As Range
    Dim nextPageNum As Integer
    Dim lastRowA As Long
    Dim lastRowB As Long
    
    Set rng = Me.Range("B:B")
    ' 若编辑的是第1行（表头行），直接退出
    If Target.Row = 1 Then Exit Sub
    ' 避免批量粘贴触发多次事件
    Application.EnableEvents = False
    
    On Error GoTo Cleanup ' 出错时恢复事件触发
    
    ' 获取A列最后一个非空单元格的行号
    lastRowA = Me.Cells(Me.Rows.Count, "A").End(xlUp).Row
    ' 获取B列最后一个非空单元格的行号
    lastRowB = Me.Cells(Me.Rows.Count, "B").End(xlUp).Row
    
    ' 确定新组的页码：A列有有效数据则取最后值+1，否则从1开始
    If lastRowA >= 1 And IsNumeric(Me.Cells(lastRowA, "A").Value) Then
        nextPageNum = Me.Cells(lastRowA, "A").Value + 1
    Else
        nextPageNum = 1
    End If
    
    ' 处理B列新增数据对应的A列填充
    If Not Intersect(Target, rng) Is Nothing Then
        For Each cell In Target.Cells
            If cell.Value <> "" And cell.Offset(0, -1).Value = "" Then
                cell.Offset(0, -1).Value = nextPageNum
            End If
        Next cell
    End If
    
    ' 定位到下一组粘贴的起始位置
    Me.Range("B" & lastRowB + 1).Select

Cleanup:
    Application.EnableEvents = True ' 恢复事件触发
End Sub

关键修改说明 #

1. 页码获取逻辑优化：不再依赖偏移量判断，直接读取A列最后一个非空单元格的数值并加1，逻辑更稳定可靠。
2. 事件防护：添加Application.EnableEvents = False，避免批量粘贴时多次触发事件，防止重复执行和错误。
3. 错误处理：增加错误捕获分支，确保无论是否出错都能恢复事件触发，避免后续操作失效。
4. 简化操作流程：移除冗余的单元格选择代码，仅定位到下一组粘贴的起始位置，操作更流畅。

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