合并单元格之前要提前将数据列排序好，然后再复制以下代码，运行宏程序。
批量合并单元格
Sub RngMergeCondition() '批量合并单元格Dim rngUser As RangeDim rngMerge As RangeDim rngSelect As RangeDim i As Long, j As LongDim lngRowFirst As LongDim lngClnFirst As LongDim arr As VariantDim brr As VariantDim strTemp As StringDim lngBK As LongDim shtUser As WorksheetOn Error Resume NextSet rngSelect = SelectionSet rngUser = Application.InputBox("请选择需要合并的单元格区域！", Default:=rngSelect.Address, Type:=8)Set rngUser = Intersect(rngUser.Parent.UsedRange, rngUser)'使用Intersect规避用户选择整列数据If rngUser Is Nothing Then MsgBox "选择的单元格区域不能为空白": Exit Subarr = rngUser.ValueReDim 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)'合并多列字符串为单个字符串Nextbrr(i, 1) = strTemp'字符串装入结果数组If i > 1 Then'如果不是第一行If brr(i - 1, 1) = strTemp ThenIf lngBK = 0 Then lngBK = i - 1'lngBK变量赋值结果数组用于存放合并行数的位置brr(lngBK, 2) = brr(lngBK, 2) + 1'累计相同值的行数ElselngBK = iEnd IfEnd IfNextApplication.ScreenUpdating = FalseApplication.DisplayAlerts = FalselngRowFirst = rngUser.Row'用户选择单元格区域的开始行lngClnFirst = rngUser.Column'用户选择单元格区域的开始列Set shtUser = rngUser.ParentFor i = 1 To UBound(brr)If brr(i, 2) > 0 ThenFor j = 1 To UBound(arr, 2)Set rngMerge = shtUser.Cells(i + lngRowFirst - 1, lngClnFirst + j - 1)rngMerge.Resize(brr(i, 2) + 1, 1).MergeNextEnd IfNextApplication.ScreenUpdating = TrueApplication.DisplayAlerts = TrueEnd Sub
批量撤销合并单元格
Sub unMergeRng() '撤销合并单元格Dim rngUser As RangeDim rngMerge As RangeDim lngRowFirst As LongDim lngRowEnd As LongDim lngClnFirst As LongDim lngColEnd As LongDim lngRowMerge As LongDim i As LongDim j As LongDim rngSelect As RangeOn Error Resume NextSet 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 SublngRowFirst = rngUser.Row'运算范围的初始行lngRowEnd = lngRowFirst + rngUser.Rows.Count - 1'运算范围的结束行lngClnFirst = rngUser.Column'运算范围的开始列lngColEnd = lngClnFirst + rngUser.Columns.Count - 1'运算范围的结束列Application.ScreenUpdating = FalseFor i = lngRowFirst To lngRowEnd'遍历行For j = lngClnFirst To lngColEnd'遍历列lngRowMerge = Cells(i, j).MergeArea.Rows.Count'合并单元格的行数If lngRowMerge > 1 ThenWith Cells(i, j).Resize(lngRowMerge, 1).Select.UnMerge'撤销合并.Value = Cells(i, j)'填充数据End WithEnd IfNexti = i + lngRowMerge - 1'跳过已处理完的合并行NextrngSelect.SelectApplication.ScreenUpdating = TrueEnd Sub
