快速合并与拆分同值单元格

每当遇到查询数据输出成Excel格式时，发现有部分数据列是重复值，一行一行的实在看着花，就会想着手动合并下，但是遇到大数据我们不是要累死？

所以我们得求助VBA解决了一劳永逸。

合并代码：

Sub hb()
Application.DisplayAlerts = False
Dim r() As Range
Set d = CreateObject("Scripting.Dictionary")
For Each cel In Range("A1:F10")
    If Not d.exists(cel.Value) Then d.Add cel.Value, d.Count
    ReDim Preserve r(d.Count – 1)
    If r(d.Item(cel.Value)) Is Nothing Then
        Set r(d.Item(cel.Value)) = cel
    Else
        Set r(d.Item(cel.Value)) = Union(cel, r(d.Item(cel.Value)))
    End If
Next cel
For i = 0 To UBound(r)
    For Each cel In r(i).Areas
        cel.Merge
    Next cel
Next i
d.RemoveAll
Application.DisplayAlerts = True
Range("A1:F10").VerticalAlignment = xlCenter
Range("A1:F10").HorizontalAlignment = xlCenter
End Sub

//A1：F10为数据区域。

取消合并代码：

Sub jy()
Dim rng As Range, val, cell As String
For Each rng In Range("A1:F10")
If rng.MergeCells Then
cell = rng.MergeArea.Address
val = rng.Value
rng.UnMerge
Range(cell).Value = val
End If
Next
End Sub