合并单元格之前要提前将数据列排序好,然后再复制以下代码,运行宏程序。
批量合并单元格
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
Dim shtUser As Worksheet
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)
'合并多列字符串为单个字符串
Next
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
'累计相同值的行数
Else
lngBK = i
End If
End If
Next
Application.ScreenUpdating = False
Application.DisplayAlerts = False
lngRowFirst = rngUser.Row
'用户选择单元格区域的开始行
lngClnFirst = rngUser.Column
'用户选择单元格区域的开始列
Set shtUser = rngUser.Parent
For i = 1 To UBound(brr)
If brr(i, 2) > 0 Then
For j = 1 To UBound(arr, 2)
Set rngMerge = shtUser.Cells(i + lngRowFirst - 1, lngClnFirst + j - 1)
rngMerge.Resize(brr(i, 2) + 1, 1).Merge
Next
End If
Next
Application.ScreenUpdating = True
Application.DisplayAlerts = True
End Sub
批量撤销合并单元格
Sub unMergeRng() '撤销合并单元格
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 Sub