如何修改Excel VBA宏实现批量将选中列月度工时拆分到4周对应单元格

修改后完整代码 #

Sub HoursSplit()
    Dim sourceRng As Range, cell As Range
    Dim targetStart As Range, currentTarget As Range
    ' 获取当前选中的目标区域起始单元格
    Set targetStart = Selection
    ' 获取剪贴板里提前复制的多人员月度工时源数据区域
    Set sourceRng = Application.CutCopyMode.Range
    
    Application.ScreenUpdating = False ' 关闭屏幕刷新提升批量处理速度
    
    ' 遍历所有选中的源工时单元格
    For Each cell In sourceRng
        ' 匹配当前人员对应的目标行起始位置
        Set currentTarget = targetStart.Offset(cell.Row - sourceRng.Row, 0)
        ' 转置粘贴源数据，和原逻辑保持一致
        cell.Copy
        currentTarget.PasteSpecial Paste:=xlPasteAll, Transpose:=True
        Application.CutCopyMode = False
        ' 写入周工时计算逻辑
        currentTarget.Offset(0, 1).FormulaR1C1 = "=RC[-1]/4"
        currentTarget.Offset(0, 2).FormulaR1C1 = "=RC[-1]"
        currentTarget.Offset(0, 3).FormulaR1C1 = "=RC[-1]"
        currentTarget.FormulaR1C1 = "=RC[1]"
    Next cell
    
    Application.ScreenUpdating = True ' 恢复屏幕刷新
End Sub

修改说明 #

• 新增源区域遍历逻辑，支持选中同一月份下任意数量的人员月度工时单元格批量处理
• 完全保留原有宏的计算规则，拆分后4个单元格数值均为原月度工时除以4，输出结果和原操作完全一致
• 新增屏幕刷新控制，批量处理时不会出现窗口闪屏，运行效率更高
• 后续如果需要调整拆分份数n，只需要修改公式里的除数，再对应增减偏移列的赋值代码即可适配

操作步骤 #

和原有使用习惯完全兼容：

1. 框选同一月份下所有需要拆分的人员月度工时单元格
2. 按Ctrl+C复制选中内容
3. 选中空白输出区域的起始单元格（即第一个人员第一周工时的填写位置）
4. 按下Ctrl+Shift+C触发宏即可一次性完成所有选中人员的工时拆分

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