取消合并单元格后 需要对单元格的 内容进行填充 求补全代码

PP不吃香菜

需求“ 从第6行开始 对所有A到E列的 合并单元格进行拆分，拆分后需要填充上”原合并“单元格的内容。

我现在有一段拆分单元格的代码。。。可以实现对合并单元格的拆分。但是拆分完是有空行的，需要填充内容 这块 我没写成功。请大家帮忙补充一下代码。。。

Sub UnmergeCellsInTop500Rows()
    Dim ws As Worksheet
    Dim rng As Range
    Dim cell As Range
   
    ' 设置工作表
    Set ws = ThisWorkbook.Sheets("Sheet1") ' 请根据实际情况修改工作表名称

    ' 定义需要处理的范围，这里限定为前500行
    Set rng = ws.Range("A6:E500")
    ' 遍历指定范围内的每个单元格
    For Each cell In rng
        ' 如果单元格是合并单元格的一部分，则取消合并
        If cell.MergeCells Then
            cell.UnMerge
        End If
    Next cell
    MsgBox "前500行内所有选定区域内的合并单元格已取消合并。", vbInformation
   
End Sub

需要实现的效果 是右边这个图片上的。

附件里已经放好 以上的代码。谢谢大家

谢谢大家

kevinchengcw

with cell.mergearea
  .unmerge: .value=.cells(1).value
end with

超级拉风的小小

Sub UnmergeCellsInTop500Rows()
    Dim ws As Worksheet
    Dim rng As Range
    Dim cell As Range

    ' 设置工作表
    Set ws = ThisWorkbook.Sheets("Sheet1")    ' 请根据实际情况修改工作表名称

    ' 定义需要处理的范围，这里选择A6开始的连续区域
   Set rng = ws.Range("A6").CurrentRegion

    ' 遍历指定范围内的每个单元格
    For Each cell In rng
        ' 如果单元格是合并单元格的一部分，则取消合并
        If cell.MergeCells Then
            cell.UnMerge
        End If
    Next cell
    For Each cell In rng
        If cell.Value = "" Then
            cell.Value = cell.Offset(-1, 0).Value
        End If
    Next cell



    MsgBox "前500行内所有选定区域内的合并单元格已取消合并。", vbInformation



End Sub

超级拉风的小小

再加一个for循环就是了，如果cell为空，那么该cell的值就等于向上偏移一个单元格的值

IE_Crayon

如有帮助来朵小红花

PP不吃香菜

IE_Crayon 发表于 2024-11-20 14:37
如有帮助来朵小红花

感谢 感谢。

yanglinzi

yanglinzi

已修改。。。

yes_cn

以前处理过这个问题。看看要得不。