VBA查找K列值后按数值右移单元格的代码简化方案

原代码存在的问题 #

• 采用逐一枚举If分支的写法实现偏移判断，仅覆盖到K列值为4的场景，要支持最大52的数值需要写几十条重复判断，冗余度极高
• 逐次循环插入单元格的写法执行效率低，遍历万行时运行速度很慢
• 未做数值合法性校验，K列出现非数字、超出范围的值时会直接抛出运行时错误
• 未遍历所有工作表，仅在当前激活工作表执行逻辑，无法完成全量执行

优化后实现代码 #

Sub Findandcut()
    Dim ws As Worksheet
    Dim row As Long
    Dim offsetNum As Variant
    
    ' 关闭屏幕刷新、事件触发，大幅提升批量操作速度
    Application.ScreenUpdating = False
    Application.EnableEvents = False
    
    ' 遍历所有工作表
    For Each ws In ThisWorkbook.Worksheets
        ' 遍历每个表的4-10000行
        For row = 4 To 10000
            offsetNum = ws.Cells(row, "K").Value
            ' 校验K列值合法性：必须为数字，且范围在1-52区间
            If IsNumeric(offsetNum) Then
                offsetNum = CLng(offsetNum)
                If offsetNum >= 1 And offsetNum <= 52 Then
                    ' 一次性插入对应数量的列，无需逐列循环插入
                    ' 注：当前偏移规则与你提供的示例代码一致：K列值为N时偏移N-1列
                    ' 若需要偏移量与K列值完全相等，将下面代码中的 offsetNum - 1 修改为 offsetNum 即可
                    ws.Cells(row, "K").Resize(1, offsetNum - 1).Insert Shift:=xlToRight
                End If
            End If
        Next row
    Next ws
    
    ' 恢复Excel默认设置
    Application.ScreenUpdating = True
    Application.EnableEvents = True
End Sub

代码说明 #

• 直接读取K列数值作为偏移计算依据，无需编写任何If分支枚举数值，天然支持1-52全范围数值判断
• 增加了全工作表遍历逻辑，满足全量执行的需求
• 采用一次性批量插入单元格的写法替代逐列循环插入，运行速度提升明显
• 增加了数值合法性校验，遇到空值、文本、超出范围的数值会自动跳过，不会中断运行

如果不需要遍历所有工作表，只需要在当前活动表执行，删除外层For Each ws In ThisWorkbook.Worksheets和对应的Next ws，把代码里的ws.Cells改回Cells即可。

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