Excel VBA小程序 -批量合并和撤销合并单元格

合并单元格之前要提前将数据列排序好，然后再复制以下代码，运行宏程序。

批量合并单元格

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 = True
End 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 = True
End Sub

Excel VBA小程序 -批量合并和撤销合并单元格相关推荐

Excel VBA小程序03-快速提取单元格中的数字和非数字
0.表格内容 A列 B列手机2134 型号324 2135手机 325型号 2手机136 32型号6 1.Word法 1.1 提取非数字遇事不决就去隔壁找Word,将表格A列内容复制到Word中, ...
Excel根据表格内容批量导入指定图片到单元格
如下图所示想根据姓名列导入对应的图像列内容,看小编如何操作呢,请看动图演示 (方方格子插件) 1.选择图片工具按钮 2.选择根据内容导入图片 3.选择图片名的拉选按钮 4.拉选图片名单元格 5 ...
Excel VBA小程序-如何快速将整个工作簿的公式转换为数值
根据操作范围,这可以分为三种情况. ❶多工作表公式转数值 ❷多工作簿公式转数值 1.多工作表公式转数值如果是将当前工作簿所有工作表的公式转换为数值,需要使用到VBA代码. Sub FunctionT ...
Excel VBA小程序01-将多个sheet表另存为单独的工作薄文件并清除原表数据
具体步骤: 按Alt+F11,打开VBA编辑器,在代码窗口中粘贴代码. 然后关闭VBA编辑器,返回Excel界面,然后按Alt+F8打开"宏"对话框,选择对应宏执行即可. 这四段 ...
Excel VBA 小程序 - 文本型数字转为数值型数字
实现功能:选中当前工作表中的所有数据内容,将文本型数字转换为数值型数字. 缺点:日期格式的字符串会变成数值 Sub 转数值型数字() With ActiveSheet.UsedRange.Number ...
学习笔记（3):EXCEL VBA编程进阶-2.10 通过方法获取单元格区域
立即学习:https://edu.csdn.net/course/play/2005/31138?utm_source=blogtoedu find速度会比较快
VBA小程序_对于选中的单元格进行取消合并_选择空值向上填充
Sub VBA小程序_对于选中的单元格进行取消合并_选择空值向上填充()Dim a As RangeSet a = Selection '定义变量为最初选择的区域,不忘初心Selection.UnMe ...
VBA小程序--针对所有已经打开的Excel文件_格式调整_针对所有工作表_冻结首行_无视所在位置
VBA小程序--针对所有已经打开的Excel文件_格式调整_针对所有工作表_冻结首行_无视所在位置 Function 格式调整_针对所有工作表_冻结首行_无视所在位置()Dim sht As Work ...
wps vba模块压缩包_01_创建第一个VBA小程序：你好，世界
大家好,我是一可赛二(Excel),EXCEL VBA爱好者,在这里分享我学习VBA的过程. 目录第一节什么是EXCEL VBA(宏) 第二节在EXCEL界面上调出"开发工具" ...

Excel VBA小程序 -批量合并和撤销合并单元格

Excel VBA小程序 -批量合并和撤销合并单元格相关推荐

最新文章

热门文章