'-----------------------------------------------------------
'
' 選択範囲の横並びのセル同士を結合する
'
'-----------------------------------------------------------
Public Sub SetMergeHorizontalRange()
Dim RangeToUse, SingleArea As Variant
Dim i, r, RowCount, FromRow, FromCol, ToCol As Long
Set RangeToUse = Selection
'複数の選択範囲が指定された場合に一選択範囲ずつ処理する
For Each SingleArea In RangeToUse.Areas
RowCount = SingleArea.Rows.Count 'セル範囲の行数
FromRow = SingleArea.Row 'セル範囲の最初の行
FromCol = SingleArea.Column 'セル範囲の最初の列
ToCol = SingleArea.Columns(SingleArea.Columns.Count).Column 'セル範囲の最後の列
For i = 1 To RowCount
r = FromRow + i - 1
Call SetMergeRange(Range(Cells(r, FromCol), Cells(r, ToCol)))
Next i
Next
End Sub
'-----------------------------------------------------------
' セル範囲を結合（書式：左揃え、文字折返し表示）
'-----------------------------------------------------------
Public Function SetMergeRange(ByVal myRange As Range)
myRange.Select
With Selection
.HorizontalAlignment = xlLeft '左揃え
.VerticalAlignment = xlCenter
.WrapText = True '文字折返し表示
.Orientation = 0
.AddIndent = False
.IndentLevel = 0
.ShrinkToFit = False
.ReadingOrder = xlContext
.MergeCells = False
End With
Selection.Merge 'セル範囲を結合
End Function
