专栏名称: Excel之家ExcelHome
excel技巧原创教程每日推送,excel表格职场模板干货仓库,图文/视频/动画等多种教学方式分享excel操作技巧教程/excel函数公式教程/excel数据透视表教程/excel图表教程/Word教程,助您轻松提高办公效率!
目录
相关文章推荐
Excel之家ExcelHome  ·  SUMIF函数的7个典型用法 ·  2 天前  
Excel之家ExcelHome  ·  计算阶梯电价,模式化公式请收好 ·  6 天前  
Excel之家ExcelHome  ·  几个常用Excel公式,新手效率提升2.7% ·  6 天前  
Excel之家ExcelHome  ·  删除表格中重复值的N种方法 ·  4 天前  
Excel之家ExcelHome  ·  IF函数用不好,天天加班做报表 ·  1 周前  
51好读  ›  专栏  ›  Excel之家ExcelHome

【Excel VBA】如何批量撤销合并单元格?

Excel之家ExcelHome  · 公众号  · Excel  · 2019-07-27 07:45

正文

周末好,之前我们分享了批量合并单元格的VBA小代码,链接参考:

【Excel VBA】如何批量合并相同值单元格?

天下大势合久必分、分久必合、分分合合合合分分又合合合再分分分又又合合合合合合合…………


今天我们分享的小代码就是如何批量撤销合并单元格……

端上动画示意图:

代码如下:

Sub unMergeRng() '撤销合并单元格
    Dim rngUser As Range
    Dim rngMerge As Range
    Dim lngRowFirst As Long
    Dim lngRowEnd As Long
    Dim lngClnFirst As Long
    Dim lngColEnd As Long
    Dim lngRowMerge As Long
    Dim i As Long
    Dim j As Long
    Dim rngSelect As Range
    On Error Resume Next
    Set rngSelect = Selection
    '用户初始选择的单元格
    Set rngUser = Application.InputBox("请选择需要撤销合并的单元格区域!", Default:=rngSelect.Address, Type:=8)
    '用户选择需要撤销合并的单元格区域
    Set rngUser = Intersect(rngUser.Parent.UsedRange, rngUser)
    'Intersect避免用户选择整列等单元格范围时,程序运算数据虚大,运算效率低下
    If rngUser Is Nothing Then MsgBox "选择的单元格区域不能为空白": Exit Sub
    lngRowFirst = rngUser.Row
    '运算范围的初始行
    lngRowEnd = lngRowFirst + rngUser.Rows.Count - 1
    '运算范围的结束行
    lngClnFirst = rngUser.Column
    '运算范围的开始列
    lngColEnd = lngClnFirst + rngUser.Columns.Count - 1
    '运算范围的结束列
    Application.ScreenUpdating = False
    For i = lngRowFirst To lngRowEnd
    '遍历行
        For j = lngClnFirst To lngColEnd
        '遍历列
            lngRowMerge = Cells(i, j).MergeArea.Rows.Count
            '合并单元格的行数
            If lngRowMerge > 1 Then
                With Cells(i, j).Resize(lngRowMerge, 1)
                    .Select
                    .UnMerge
                    '撤销合并
                    .Value = Cells(i, j)
                    '填充数据
                End With
            End If
        Next
        i = i + lngRowMerge - 1
        '跳过已处理完的合并行
    Next
    rngSelect.Select
    Application.ScreenUpdating = True
End Sub


专业的职场技能充电站