VBA常用小代码102：批量合并相同值单元格

茫然走在海边，看那潮来潮去，徒劳无功想把 每朵浪花记起……

诸君好，我们今天分享的VBA小代码内容是批量合并相同值的单列单元格。

照例举个例子，如下图所示，A列是班级字段，需要将相同的班级单元格修改为合并单元格……。

代码如下：

---

Sub MergeRange()

    'EH技术论坛：VBA编程学习与实践 看见星光

    Dim Rng As Range

    Dim i&, Col&, Fist, Last

    Set Rng = Application.InputBox('请选择单列数据列！', Type:=8)

    '用户选择数据列

    Set Rng = Intersect(Rng.Parent.UsedRange, Rng)

    'intersect语句避免用户选择整列造成无谓运算

    Col = Rng.Column 'Rng所在列

    Fist = Rng.Row

    'Rng开始行，用户选择的区域并不是一定从第一行开始，因此需要此句判断

    Last = Fist Rng.Rows.Count - 1 'Rng结束行

    Application.ScreenUpdating = False '取消屏幕更新

    Application.DisplayAlerts = False

    '取消消息提醒。当有值单元格被合并时屏蔽提示信息

    Rng.Parent.Select '激活Rng对象所在的工作表，避免跨工作表操作问题

    For i = Last To Fist 1 Step -1

    '对Rng进行从后向前遍历

        If Cells(i, Col) = Cells(i - 1, Col) Then

            Cells(i - 1, Col).Resize(2, 1).Merge

        End If

    Next

    Rng.VerticalAlignment = xlCenter '格式上下居中

    Application.ScreenUpdating = True

    Application.DisplayAlerts = True

    MsgBox '合并完成。'

End Sub

---

小贴士：

1，该段代码只支持单列单元格区域，例如A10:A20，B2:B500等。

2，由于merge合并后的单元格区域只保留右上角首个单元格的值，因此该段代码遍历单元格区域的顺序是从后向前，而不是从前向后，后者是新人常出错之处。

3，当然也可以采用从前向后的遍历顺序，先将Rng装入数组，对数组中的数据进行遍历判断是否等同，标记头尾行号，再批量合并单元格。该方法的效率也会高于遍历单元格两两合并的方法。

……感冒头疼……听完大海，就说晚安~

一码不扫，
可以扫天下？

ExcelHome

VBA编程学习与实践