Option Explicit
Sub 取消合併儲存格_空格填入原合併值()
Dim seL As Range, rnG As Range, T, ad$
T = Timer
Set seL = Cells
For Each rnG In seL.SpecialCells(2)
If rnG.MergeCells = True Then
rnG.Select '有這個動作會比較慢
ad = Selection.Address
rnG.MergeCells = False
Range(ad) = Range(ad).Item(1)
End If
Next
seL.MergeCells = False'補取消 原合併格就無值的除存格
MsgBox "共耗時:" & Timer - T & " 秒"
End Sub作者: n7822123 時間: 2020-8-18 12:15
Sub 取消合併儲存格_空格填入原合併值_New()
Dim rnG As Range, T, ad$
T = Timer
For Each rnG In Cells.SpecialCells(2)
If rnG.MergeCells = True Then
ad = rnG.MergeArea.Address
With Range(ad)
.MergeCells = False
.Value = .Item(1)
End With
End If
Next
Cells.MergeCells = False '補取消 原合併格就無值的除存格
MsgBox "共耗時:" & Round(Timer - T, 3) & " 秒"
End Sub作者: Andy2483 時間: 2020-8-23 15:03
Dim xR As Range
For Each xR In Cells.SpecialCells(2)
With xR.MergeArea
If .Count > 1 Then .UnMerge: .Value = xR.Value
End With
Next作者: Andy2483 時間: 2020-8-24 09:21
Sub 有註解的合併格_取消合併與複製()
Dim uR As Range, com As Comment
For Each com In ActiveSheet.Comments
Set uR = com.Parent.MergeArea
With uR
If .Count > 1 Then
.UnMerge
uR.Item(1).Copy uR
End If
End With
Next
End Sub