周末好,之前我们分享了批量合并单元格的VBA小代码,链接参考:
【Excel VBA】如何批量合并相同值单元格?
天下大势合久必分、分久必合、分分合合合合分分又合合合再分分分又又合合合合合合合…………
今天我们分享的小代码就是如何批量撤销合并单元格……
端上动画示意图:
代码如下:
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 SubSub unMergeRng() '撤销合并单元格
专业的职场技能充电站