超实用Excel VBA工具箱2-拆分合并的单元格并填充原值

需求介绍:

        在我的上一篇文章《超实用Excel VBA工具箱1-合并内容相同的单元格》中,介绍了“同类合并”的功能。这次介绍它的逆需求,我称它为“带值拆分”。例如,我们需要计算每个部门员工的平均工资,但很多时候我们得到的数据是表1这样的格式,那么我们需要首先将表1转换为表2。也就是说,要将取消单元格合并,并将原先合并单元格中的值填充到每一个被拆分出的单元格中。


编写功能代码模块

整体思路:

  1. 将选中区域的所有合并单元格取消(为其他影响,这里我们限定代码只对选中区域的第一列有效),取消合并后,仅有每个合并区域的第一个单元格有值,其它的都是空的。
  2. 循环选中区域的所有行,如果单元格的值为空,则使用上一行的值填充。
Sub 带值拆分(Control As IRibbonControl)
    Dim r As Long, nRow As Long
    Application.DisplayAlerts = False '关闭提示,如果不关闭会反复提示是否合并单元格
    Application.ScreenUpdating = False '关闭屏幕刷新,避免程序执行过程中屏幕卡顿
    With Selection.Columns(1) '限定代码只对选中区域的第一列有效
        nRow = Selection.Rows.Count '获取行数
        .MergeCells = False '取消选择区域所有合并的单元格
        For r = 2 To nRow '遍历所有选中的行
            If .Cells(r, 1) = "" Then '如果单元格是空的,就用上一行单元格的值填充
                .Cells(r, 1) = .Cells(r - 1, 1)
            End If
        Next
    End With
    Application.DisplayAlerts = True '重新打开提示功能
    Application.ScreenUpdating = True '重新打开屏幕刷新
End Sub

在Excel功能区添加按钮

再使用RibbonXMLEditor将带值拆分的按钮创建到自定义功能区中。关于RibbonXMLEditor的使用方法可以参考我的另一篇文章《RibbonXMLEditor_8.0工具使用介绍》。

<?xml version="1.0" standalone="yes"?>
<customUI xmlns="http://schemas.microsoft.com/office/2006/01/customui">
	<ribbon startFromScratch="false">
		<tabs>
			<tab id="tab1" label="超级工具箱">
				<group id="grp1" label="单元格工具">
					<button id="but1" label="同类合并" onAction="同类合并" imageMso="CellStylesMerge" size="large"/>
					<button id="but2" label="带值拆分" onAction="带值拆分" imageMso="AdpDiagramArrangeTables" size="large"/>
				</group>
			</tab>
		</tabs>
	</ribbon>
</customUI>

评论 4
添加红包

请填写红包祝福语或标题

红包个数最小为10个

红包金额最低5元

当前余额3.43前往充值 >
需支付:10.00
成就一亿技术人!
领取后你会自动成为博主和红包主的粉丝 规则
hope_wisdom
发出的红包
实付
使用余额支付
点击重新获取
扫码支付
钱包余额 0

抵扣说明:

1.余额是钱包充值的虚拟货币,按照1:1的比例进行支付金额的抵扣。
2.余额无法直接购买下载,可以购买VIP、付费专栏及课程。

余额充值