| |
▼べに さん：
一度、値を結合範囲にセットしながら解除して
並び替え後に再度結合するとかどうでしょう？
A列以外にも結合範囲があるのなら
うまく応用してください。
Option Explicit
Sub Test()
Dim Ran As Range
Dim MerR As Range
Dim R As Range
Dim buf As String
'結合解除
For Each Ran In Range("A1:A6")
If Ran.MergeCells Then
buf = Ran.MergeArea(1, 1).Value
Set MerR = Ran.MergeArea
Ran.UnMerge
For Each R In MerR
R.Value = buf
Next R
Set MerR = Nothing
End If
Next Ran
'並べ替え
Range("A:C").Sort Key1:=Range("A1"), Order1:=xlAscending, Header:=xlGuess, _
OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom, SortMethod _
:=xlPinYin
'再結合
Application.DisplayAlerts = False
For Each Ran In Range("A1:A6")
If Ran.MergeArea(1, 1).Value = Ran.Offset(1).Value Then
Union(Ran.MergeArea, Ran.Offset(1)).Merge
End If
Next Ran
Application.DisplayAlerts = True
End Sub
|
|
![[未読]](./data/excel/image/read_icon.gif){kind=icon}
