很久以前，我们和大家分享过一段类似功能的代码，链接：【Excel VBA】批量合并相同值单元格

但那段代码只支持单列数据合并……

另外，在那段推文的结尾，我们也留了一个尾巴。尾巴里说使用数组的方法，批量合并效率会高于遍历单元格两两合并……

打个响指，欠揍脸，我们今天和大家分享的方法就是数组法的啦。

效果动画如下：

1，该段代码支持用户选择单列或多列数据，选择区域的整行数据相同则进行合并。

2，代码照例允许用户选择整列数据，也不用担心运算量过大，系统假死的情况。

3，代码使用了一个数组brr用于存放数据以及合并单元格的行数。VBA在使用数组处理数据时，这个方法是经常使用到的。如果你函数还可以，那么你可以把这样的数组理解为辅助列。对于函数大神，比如曾经的我，可能相当讨厌辅助列，认为不够表现高超的水平；但是，在VBA中，善于使用辅助列性质的数组不但是个好习惯，而且经常是解决问题的最好方法，任性的不加之一。

4，事实上这段代码也可以不使用数组brr，而只使用变量……

5，我们下期再分享如何批量撤销合并单元格。

晚安，晚安，晚安……

代码如下：

Sub RngMergeCondition() '批量合并单元格

Dim rngUser As Range

Dim rngMerge As Range

Dim rngSelect As Range

Dim i As Long, j As Long

Dim lngRowFirst As Long

Dim lngClnFirst As Long

Dim arr As Variant

Dim brr As Variant

Dim strTemp As String

Dim lngBK As Long

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

arr = rngUser.Value

ReDim brr(1 To UBound(arr), 1 To 2)

'结果数组，第一列保存值，第二列保存合并行数

For i = 1 To UBound(arr)

strTemp = ""

For j = 1 To UBound(arr, 2)

strTemp = strTemp & "@@" & arr(i, j)

'合并多列字符串为单个字符串

brr(i, 1) = strTemp

'字符串装入结果数组

If i > 1 Then

'如果不是第一行

If brr(i - 1, 1) = strTemp Then

If lngBK = 0 Then lngBK = i - 1

'lngBK变量赋值结果数组用于存放合并行数的位置

brr(lngBK, 2) = brr(lngBK, 2) + 1

'累计相同值的行数

lngBK = i

End If

End If

Application.ScreenUpdating = False

Application.DisplayAlerts = False

lngRowFirst = rngUser.Row

'用户选择单元格区域的开始行

lngClnFirst = rngUser.Column

'用户选择单元格区域的开始列

For i = 1 To UBound(brr)

If brr(i, 2) > 0 Then

For j = 1 To UBound(arr, 2)

Set rngMerge = Cells(i + lngRowFirst - 1, lngClnFirst + j - 1)

rngMerge.Resize(brr(i, 2) + 1, 1).Merge

End If

Application.ScreenUpdating = True

Application.DisplayAlerts = True

rngSelect.Select

End Sub

硬核VBA经典代码应用大全

淘宝、京东、当当各大商城均有销售 返回搜狐，查看更多

责任编辑：

平台声明：该文观点仅代表作者本人，搜狐号系信息发布平台，搜狐仅提供信息存储空间服务。

阅读 ( )