循环将工作表数据复制至偏移单元格并添加后缀字符

需求说明 #

复制指定单元格的值并添加额外字符后缀。B列存在Example1至Example4这类值，需要将其复制到下方对应位置（对应C列标记为addEx的行的B列单元格），由于数据间行数不固定，无法使用固定偏移行数，计划以C列为参考点实现该操作。

原代码存在的问题 #

• 大量使用Select和Activate，不仅运行效率低下，还容易因操作界面切换导致逻辑错误
• 循环中重复调用Cells.Find，可能出现重复定位同一标记单元格的冗余操作
• 未处理找不到目标值的边界情况，可能触发运行时错误

优化后的VBA代码 #

Sub CopyWithSuffix()
    Dim ws As Worksheet
    Dim rngC As Range
    Dim targetCell As Range
    Dim sourceCell As Range
    Const markerText As String = "addEx" ' 参考列的标记文本
    Const suffixText As String = "b"     ' 要添加的后缀字符
    
    ' 指定操作的工作表，避免激活其他工作表时出错
    Set ws = ThisWorkbook.ActiveSheet
    ' 动态获取C列实际使用的单元格范围（从C1到最后一行非空单元格）
    Set rngC = ws.Range("C1", ws.Cells(ws.Rows.Count, "C").End(xlUp))
    
    ' 遍历C列的每个标记单元格
    For Each targetCell In rngC
        If targetCell.Value = markerText Then
            ' 定位B列中当前标记行上方的最后一个非空单元格
            Set sourceCell = ws.Cells(targetCell.Row - 1, "B").End(xlUp)
            ' 直接将源值加后缀后赋值到目标位置（无需复制粘贴）
            targetCell.Offset(0, -1).Value = sourceCell.Value & suffixText
        End If
    Next targetCell
End Sub

代码关键说明 #

• 摒弃Select/Activate操作：直接通过单元格对象进行取值和赋值，大幅提升代码运行效率与稳定性
• 动态范围适配：自动获取C列实际使用的最后一行，避免固定范围导致的遗漏或无效遍历
• 简化逻辑流程：找到标记单元格后，直接定位源数据单元格，取值加后缀后完成赋值，省去复制粘贴的冗余步骤
• 常量化配置：将标记文本和后缀字符定义为常量，后续修改需求时只需调整常量值即可

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