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


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

分享到:

0 条评论

注意: 评论者允许使用'@user空格'的方式将自己的评论通知另外评论者。例如, ABC是本文的评论者之一,则使用'@ABC '(不包括单引号)将会自动将您的评论发送给ABC。使用'@all ',将会将评论发送给之前所有其它评论者。请务必注意user必须和评论者名相匹配(大小写一致)。

昵称

沙发空缺中,还不快抢~