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


Excel同值合并

每当遇到查询数据输出成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

分享到: