Excel VBA实现N列变动编码动态复制填充至O列对应工单行

核心需求 #

• 提取N列首次出现的8202xxxx-xxxxxxxx格式编码，复制到同行O列单元格
• 将编码向下填充至同组所有后续存在工单号的行，例：N4的编码需同步填充到O4、O5、O6
• 适配无固定规律的数据：A列每组工单数量不固定，每组对应8202开头的编码可变动，编码后缀无需连续，支持前缀不变后缀随机跳转的场景

现存问题 #

原拼凑代码可运行，但存在两个待修复缺陷：

• 硬编码最大遍历行为250行，无法自动适配实际数据行数（实际数据约150行）
• 会在A列无工单号的空行粘贴编码，产生无效数据

原参考代码 #

Sub COPYROWS()
    Dim x As String
    Dim y As Long
    Dim wb As Workbook

    ThisWorkbook.Activate
    Worksheets("123").Activate

    For i = 1 To 200
      If Not Cells(i, 14) = vbNullString And Not Cells(i, 1) = vbNullString Then
        x = Cells(i, 14).Value
        Cells(i, 15).Select
        ActiveCell.Value = x
            Do While y <= 2
            y = 1
            Cells(i, 15).Select
            Range(ActiveCell, Cells(250, 15)).Select
            Selection.Value = x
            y = y + 1
            Exit Do
            Loop
      End If
    Next i
End Sub

优化后可直接运行代码 #

Sub COPYROWS()
    Dim lastRow As Long
    Dim currentCode As String
    Dim ws As Worksheet
    Dim i As Long
    
    ' 绑定目标工作表
    Set ws = ThisWorkbook.Worksheets("123")
    ' 自动识别A列（工单列）最后一条数据的行号，替代硬编码行值
    lastRow = ws.Cells(ws.Rows.Count, "A").End(xlUp).Row
    
    ' 逐行遍历实际数据范围
    For i = 1 To lastRow
        ' 遇到新的分组编码（N列非空且当前行有工单号）时，更新缓存的编码值
        If ws.Cells(i, "N").Value <> vbNullString And ws.Cells(i, "A").Value <> vbNullString Then
            currentCode = ws.Cells(i, "N").Value
        End If
        
        ' 仅对存在工单号的行写入编码，跳过A列空行
        If ws.Cells(i, "A").Value <> vbNullString And currentCode <> vbNullString Then
            ws.Cells(i, "O").Value = currentCode
        End If
    Next i
End Sub

优化说明 #

• 自动适配数据行数：通过Excel内置的End(xlUp)方法定位A列最后一个非空单元格，无论数据是100行还是300行都无需修改代码
• 空行自动跳过：所有O列写入操作增加A列非空判断，无工单号的行不会写入任何内容
• 移除冗余的Select/Activate操作：直接操作单元格对象，运行速度更快，不会触发屏幕闪动
• 适配无规律数据：通过变量缓存当前分组的编码，遇到N列新编码时自动切换，无需判断编码后缀是否连续，适配任意分组长度

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