VBA实现基于选中单元格相对位置的步骤序列自动填充

原有参考代码的不足 #

你参考的工作日填充示例采用固定单元格范围绑定、手动运行触发的逻辑，无法适配任意单元格输入触发、相对位置填充的需求，需要改用工作表Change事件实现输入动作实时监听，所有位置计算均以当前输入单元格为基准，无需写死固定范围。

部署步骤 #

• 打开需要启用该功能的Excel文件，按Alt+F11快捷键调出VBA编辑器
• 在左侧工程资源管理器面板中，双击需要生效的对应工作表（如Sheet1），打开该工作表的专属代码窗口
• 将下方完整代码粘贴到代码窗口中，保存文件为启用宏的格式（.xlsm）即可正常使用

完整实现代码 #

Private Sub Worksheet_Change(ByVal Target As Range)
    Dim fillIndex As Integer
    ' 临时关闭事件触发，避免填充动作递归触发本事件造成死循环
    Application.EnableEvents = False
    On Error GoTo ErrorRecover
    
    ' 仅处理单个单元格的输入场景，批量多选单元格输入时不触发填充
    If Target.CountLarge = 1 Then
        ' 匹配输入内容：自动忽略前后空格、不区分大小写
        If Trim(UCase(Target.Value)) = "STEP 6" Then
            ' 以当前输入单元格为基准，向右连续5个单元格依次填充Step5到Step1
            For fillIndex = 1 To 5
                Target.Offset(0, fillIndex).Value = "Step " & 6 - fillIndex
            Next fillIndex
        End If
    End If

ErrorRecover:
    ' 无论是否运行出错，都恢复事件监听机制
    Application.EnableEvents = True
End Sub

代码逻辑说明 #

• 无任何固定单元格绑定，所有位置偏移都以触发输入的单元格（即代码中Target对象）为基准，Offset(0, fillIndex)代表同行下向右偏移fillIndex列的单元格，完全满足相对位置填充要求
• 内置事件防递归机制和错误捕获，不会出现死循环、运行出错后Excel功能失效的问题
• 默认匹配规则忽略输入内容前后空格、不区分大小写，输入step 6、STEP 6这类变体内容都能正常触发

如果需要严格匹配大小写为"Step 6"才触发，可将判断条件修改为If Trim(Target.Value) = "Step 6" Then即可。

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