超实用Excel VBA工具箱1-合并内容相同的单元格

        工作中,我们有时会遇到这样一种需求,需要将某一列中内容相同的单元格进行合并。例如下图中,需要将相同的部门进行合并,由表1转换为表2。如果你需要经常处理这种需求,就可以自定义一个功能放到Excel的自定义功能区里。比如我们把这种需求叫做“同类合并”


编写功能代码模块

整体思路:遍历选择的区域,判断前后单元格内容是否相同,如果相同合并单元格,如果不同跳过。

Sub 同类合并()
    Dim r As Long, nRow As Long
    Application.DisplayAlerts = False '关闭提示,如果不关闭会反复提示是否合并单元格
    Application.ScreenUpdating = False '关闭屏幕刷新,避免程序执行过程中屏幕卡顿
    With Selection
        nRow = Selection.Rows.Count '获取行数
        For r = nRow - 1 To 1 Step -1 '遍历所有选中的行,但是要注意这里一定要倒序遍历
            If Selection.Cells(r, 1) = Selection.Cells(r + 1, 1) Then '判断前后单元格内容是否相同
                Range(Selection.Cells(r, 1), Selection.Cells(r + 1, 1)).Merge '如果相同执行合并单元格
            End If
        Next
        End With
    Application.DisplayAlerts = True '重新打开提示功能
    Application.ScreenUpdating = True '重新打开屏幕刷新
End Sub

在Excel功能区添加按钮

使用RibbonXMLEditor可以快速在Excel功能区创建一个按钮。关于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"/>
				</group>
			</tab>
		</tabs>
	</ribbon>
</customUI>

  • 5
    点赞
  • 7
    收藏
    觉得还不错? 一键收藏
  • 2
    评论
### 回答1: Sub MergeCells() Dim Rng As Range Dim xCell As Range Dim xRows As Integer Dim xCols As Integer Dim xTxt As String On Error Resume Next xTxt = InputBox("请输入要合并内容:") Set Rng = Application.InputBox("请选择要合并的区域:", xTitleId, Type:=8) xRows = Rng.Rows.Count xCols = Rng.Columns.Count For Each xCell In Rng If xCell.Value = xTxt Then If xCell.MergeCells = False Then xCell.Resize(xRows, xCols).Merge End If End If Next End Sub ### 回答2: 下面是一段VBA代码,可以对相同内容单元格进行合并: ```VBA Sub 合并单元格() Dim LastRow As Long Dim rng As Range Dim cell As Range ' 获取最后一行 LastRow = ActiveSheet.Cells(Rows.Count, 1).End(xlUp).Row ' 设置合并范围 Set rng = Range("A1:A" & LastRow) ' 遍历每个单元格 For Each cell In rng ' 判断当前单元格和下一个单元格内容是否相同 If cell.Value = cell.Offset(1, 0).Value Then ' 合并单元格 cell.Offset(1, 0).Merge cell End If Next cell ' 清除格式 rng.MergeCells = False End Sub ``` 使用以上代码,首先将代码粘贴到VBA编辑器中,然后在Excel表格中运行这段代码。代码会遍历指定范围的单元格,检查当前单元格和下一个单元格内容是否相同,如果相同,则将它们合并为一个单元格,直到所有相同内容单元格都被合并。最后,代码会清除合并单元格时可能出现的格式。 ### 回答3: 下面是一个简单的VBA代码,用于对相同内容单元格进行合并: ```vba Sub 合并相同内容单元格() Dim LastRow As Long Dim i As Long ' 获取最后一行 LastRow = Cells(Rows.Count, 1).End(xlUp).Row ' 遍历每一行 For i = 2 To LastRow ' 检查与上一行相同内容 If Cells(i, 1).Value = Cells(i - 1, 1).Value Then ' 合并相同内容单元格 Range(Cells(i - 1, 1), Cells(i, 1)).Merge End If Next i End Sub ``` 此代码使用了一个`For`循环,从第二行开始逐行检查,如果当前行的内容与前一行的内容相同,则使用`Merge`命令合并这两行单元格内容。 循环中使用的`Range`函数用于指定要合并单元格范围。 这个例子中,代码只检查了第一列的内容,你可以根据需要进行修改。 请注意,此代码是基于Microsoft Excel应用程序的VBA代码,因此需要在Excel中打开并使用。

“相关推荐”对你有帮助么?

  • 非常没帮助
  • 没帮助
  • 一般
  • 有帮助
  • 非常有帮助
提交
评论 2
添加红包

请填写红包祝福语或标题

红包个数最小为10个

红包金额最低5元

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

抵扣说明:

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

余额充值