Merge，Unmerge，Remerge宏

Question

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

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

End Sub

Answer 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

Answer 2

你必须：

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

• 使用Range object

的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