Excel按列合并相同相邻单元格和拆分单元格

目录

1.使用vba的方式

1.1合并相同相邻单元格

1.2 拆分单元格

2.使用分类汇总+定位ctrl+G的手工方法

---

1.使用vba的方式

1.1合并相同相邻单元格

代码如下：

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

1.2 向下合并空白单元格

代码如下：

Sub downMergeBlankCell()
Dim qCnt&, zCnt&, xCnt&, yCnt&
qCnt = 1
zCnt = 1
With Selection
    For yCnt = 1 To .Columns.Count
        For xCnt = 1 To .Rows.Count
            If .Cells(xCnt, yCnt) = "" Then
                zCnt = xCnt
            Else
                .Cells(qCnt, yCnt).Resize(zCnt - qCnt + 1, 1).Merge
                qCnt = xCnt
                zCnt = xCnt
            End If
        Next xCnt
        .Cells(qCnt, yCnt).Resize(zCnt - qCnt + 1, 1).Merge
        qCnt = xCnt
        zCnt = xCnt
    Next yCnt
    .HorizontalAlignment = xlCenter '居中
    .VerticalAlignment = xlCenter '垂直居中
End With
MsgBox "所选单元格合并完毕！"
End Sub

 

1.3 拆分单元格

代码如下：

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

 拆分前：

拆分后：

以上摘自

https://www.csdn.net/tags/Ntzakg4sNDMxMjUtYmxvZwO0O0OO0O0O.html

2.使用分类汇总+定位ctrl+G的手工方法

前提条件是向下有相同的单元格 如果向下是空的单元格需要先搞成相同单元格：

 

 

 然后复制粘贴A列为值，然后就可以用一下的分类汇总了

 以下摘自百度

百度安全验证https://baijiahao.baidu.com/s?id=1716740632111022951&wfr=spider&for=pc

这个方法是小编知道最早流传的经典操作技巧之一，我们先选中需要合并单元格字段列的单元格区域，在数据选项卡中的分级显示找到分类汇总，选择后会弹出一个提示，我们确定后会按照部门列字段进行分类汇总，接着对左边多出来的汇总列区域选中，按快捷键Ctrl+G或者F5定位空值，然后在开始选项卡中将定位的空单元格合并。

继续选中D列部门字段单元格区域，再次打开分类汇总对话框，然后点击全部删除，把多余的C列删除。这样操作下来，部门字段中相同内容的单元格就全部被合并了。