合并、取消合并、重新合并宏

Posted 2023-02-23

【中文标题】合并、取消合并、重新合并宏

【英文标题】：Merge, Unmerge, Remerge macro

【发布时间】：2017-05-27 21:46:54

【问题描述】：

我正在开发一个宏来取消合并给定范围内的合并单元格，然后重新合并未合并的原始合并单元格。我一直在努力确定如何存储最初未合并的单元格列表，以便宏可以重新合并那些确切的单元格。电子表格中合并的行每周都在变化。

Sub MergeUnmerge()

'

Mergeunmerge Macro
'

Dim mergelist As Range

Dim celllist As Range


For Each cell In Range("A1:S49")

If cell.MergeCells = True Then
   Set mergelist = celllist
            cell.UnMerge
        End If
    Next

 For Each cell In mergelist
    Range("celllist").Merge
Next

结束子

【问题讨论】：

您应该考虑使用集合或数组来存储您的信息，以便在您完成主要任务后对其进行处理。即将每个合并区域的地址（Range.MergeArea.Address）添加到集合中，然后您可以取消合并所有单元格，完成任务然后合并集合中每个项目的单元格

我用一个经过测试的工作解决方案编辑了我的答案。

【参考方案1】：

您需要将MergeArea 地址添加到数组中。

Sub MergeUnmerge()

Dim cel As Range
Dim mergeArr()  
y = 0

For Each cel In Range("A1:S49")
    If cel.MergeCells = True Then
        ReDim Preserve mergeArr(y + 1)
        mergeArr(y + 1) = cel.MergeArea.Address
        cel.UnMerge
        y = y + 1
    End If
Next cel

For x = 1 To y
    Range(mergeArr(x)).Merge
Next x

End Sub

【讨论】：

我会让它更通用并引入一个Range 参数，并在循环外声明mergeArr() 和If 块以提高可读性。声明接近使用的变量是一个非常好的主意，但当代码（暂时）令人困惑时不是这样;-)

完全放弃 @Mat'sMug

【参考方案2】：

你必须：

使用mergeCells 属性检查合并单元格

使用Range对象的Areas属性

使用Merge方法将区域合并回来

点赞

Option Explicit

Sub MergeUnmerge()
    Dim mergedCells As Range
    Dim cell As Range

    With Range("A1:S49") '<--| reference your range
        Set mergedCells = .Offset(.Rows.Count, .Columns.Count).Resize(1, 1) '<--| initialize mergedCells range to a spurious cell out of referenced range
        For Each cell In .Cells '<--|loop through referenced range cells
            If cell.mergeCells Then '<--| if current cell belongs to a merged area
                Set mergedCells = Union(mergedCells, cell.MergeArea) '<--| update 'mergedCells' range
                cell.UnMerge '<--| unmerge it
            End If
        Next

        Set mergedCells = Intersect(mergedCells, .Cells) '<--| filter out the spurious cell
        If Not mergedCells Is Nothing Then '<--| if there's some cell left
            For Each cell In mergedCells.Areas '<--| loop through areas
                cell.Merge '<--| merge curent area
            Next
        End If
    End With
End Sub