合并和拆分单元格

要求将下图所示的数据，部门相同的单元格按照部门合并。

Snap1.jpg

VBA法

Sub 合并相同的单元格()
    '变量声明
    Dim strDep  As String
    Dim RowN    As Long
    Dim rng     As Range
    '获取第一行的部门信息
    strDep = Cells(2, 1).Value
    Set rng = Cells(2, 1)
    '关闭警告提示
    Application.DisplayAlerts = False
    '循环遍历A列，从第2行至数据最后的下一行
    For RowN = 2 To 26
        If strDep = Cells(RowN, 1).Value Then
            '部门相同，获取合并的单元格区域对象
            Set rng = Union(rng, Cells(RowN, 1))
        Else
            '部门不同，进行合并单元格
            rng.Merge
            '重新获取部门信息
            strDep = Cells(RowN, 1).Value
            Set rng = Cells(RowN, 1)
        End If
    Next RowN
    '开启警告提示
    Application.DisplayAlerts = True
End Sub

合并后效果如下：

Snap2.jpg

反向操作

Sub 拆分合并单元格()
    Dim t As Variant
    Dim strAddr
    Dim c As Range
    Dim r As Range
     
    For Each r In Range("A2:A25")
        If r.MergeCells Then
            t = r.Value
            strAddr = r.MergeArea.Address
            r.UnMerge
        End If
         
        For Each c In Range(strAddr)
            c.Value = t
        Next
    Next
End Sub
···