合并，Unmerge，Remergemacros
我正在研究一个macros，在给定范围内取消合并的单元格，然后重新合并未合并的原始合并单元格。 我一直在努力确定如何存储最初未被合并的单元列表，以便macros可以重新合并这些确切的单元格。在电子表格中合并的行每周都会改变。
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 结束小组
你必须：
-
使用
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
您需要将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