目录
1，合并选中单元格区域，并保留所有内容举例2，合并选中单元格区域，仅合并连续相同的值3，撤销选中区域内的合并单元格，并对单元格赋值原值举例4，选中列向下合并连续空单元格举例1，合并选中单元格区域，并保留所有内容
Sub 合并选中单元格区域并保留所有数据()'合并选中单元格，单个单元格、单行、单列、多行多列都适用，可指定分隔符Dim rng As Range, result As Stringdelimiter = "，"'分隔符For Each rng In Selection '从上到下、从左到右顺序result = result & delimiter & rng.ValueNext rngresult = Right(result, Len(result) - Len(delimiter)) '返回结果，同时去除开头的分隔符With Selection.Value = Empty '内容清空.Merge '合并单元格.Value = result '内容赋值.WrapText = True '是否自动换行End WithEnd Sub
举例
A、B列选中运行代码后得到D、E列效果
2，合并选中单元格区域，仅合并连续相同的值
Sub 合并选中单元格区域的连续同值()'合并选中单元格，适用单行、单列、多行多列区域Dim rng As Range, dict As Object, i, key_i, vSet rng = Intersect(ActiveSheet.UsedRange, Selection) 'intersect语句避免选择整列造成无用计算Set dict = CreateObject("scripting.dictionary")Application.ScreenUpdating = False '关闭屏幕更新，加快程序运行Application.DisplayAlerts = False '不显示警告信息For Each i In rngkey_i = CStr(i.Value)If Not dict.Exists(key_i) ThenSet dict(key_i) = iElseSet dict(key_i) = Application.Union(dict(key_i), i)End IfNextv = dict.ItemsFor i = 0 To dict.count - 1v(i).MergeNextApplication.ScreenUpdating = TrueApplication.DisplayAlerts = TrueEnd Sub
3，撤销选中区域内的合并单元格，并对单元格赋值原值
Sub 撤销选中区域的合并单元格()'撤销选中合并单元格，所有单元格赋值，单行、单列、多行多列都适用Dim rng As Range, i&, j&, first_row&, last_row&, first_col&, last_col&Set rng = Intersect(ActiveSheet.UsedRange, Selection) 'intersect语句避免选择整列造成无用计算first_row = rng.Row'选中区域开始行号last_row = first_row + rng.Rows.count - 1 '选中区域结束行号first_col = rng.Column '选中区域开始列号last_col = first_col + rng.Columns.count - 1 '选中区域结束列号Application.ScreenUpdating = False '关闭屏幕更新，加快程序运行Application.DisplayAlerts = False '不显示警告信息For i = first_row To last_rowFor j = first_col To last_colIf Cells(i, j).MergeCells Then '区域内是否包含合并单元格With Range(Cells(i, j).MergeArea.Address) '合并单元格地址.UnMerge '撤销合并.Value = Cells(i, j).Value '全部赋值End WithEnd IfNextNextApplication.ScreenUpdating = TrueApplication.DisplayAlerts = TrueEnd Sub
举例
A列选中运行sub2后得到C列效果；相反C列选中运行sub3后得到A列效果
4，选中列向下合并连续空单元格
Sub 选中列向下合并连续空单元格()Dim rng As Range, i&, first_row&, last_row&, first_col&, s_row&, e_row&Set rng = Intersect(ActiveSheet.UsedRange, Selection) 'intersect语句避免选择整列造成无用计算If rng.Columns.Count > 1 Then Debug.Print "仅支持单列": Exit Sub '仅支持单列，多列则退出first_row = rng.row'选中区域开始行号last_row = first_row + rng.Rows.Count - 1 '选中区域结束行号first_col = rng.column '选中区域开始列号s_row = first_row: e_row = first_row '行号起止初始化For i = first_row To last_rowIf Cells(i, first_col).Value = "" Thene_row = iElseIf s_row <> e_row Then Cells(s_row, first_col).Resize(e_row - s_row + 1, 1).Merge '非空合并s_row = i: e_row = iEnd IfIf s_row <> e_row Then Cells(s_row, first_col).Resize(e_row - s_row + 1, 1).Merge '最后一个合并NextEnd Sub
举例
A列选中运行代码得到E列效果
如果觉得《Excel·VBA单元格合并 撤销合并》对你有帮助，请点赞、收藏，并留下你的观点哦！
