'*****************************************************************************
'[ 関数名 ]　MergeRows
'[ 概 要 ]　先頭行が結合セルの時、先頭行から底の行まで縦方向に結合する
'[ 引 数 ]　objTopRow：結合の先頭行、objBottomRow：結合の底の行
'[ 戻り値 ]　なし
'*****************************************************************************
Private Sub MergeRows(ByRef objTopRow As Range, ByRef objBottomRow As Range)
Dim i As Long
Dim lngLast As Long

'選択されたすべての列を整備する
lngLast = objTopRow.Columns.Count

'1列毎にループ
For i = 1 To lngLast
'新しい行のセルが結合セルか
If objBottomRow.Cells(1, i).MergeCells = False Then
'元のセルが結合セルか
If objTopRow.Cells(1, i).MergeCells = True Then
Call Range(objTopRow.Cells(1, i).MergeArea, objBottomRow.Cells(1, i)).Merge
End If
End If
Next i
End Sub

'*****************************************************************************
'[ 関数名 ]　MergeRows2
'[ 概 要 ]　先頭行から底の行まで縦方向に結合する
'[ 引 数 ]　objTopRow：結合の先頭行、objBottomRow：結合の底の行
'[ 戻り値 ]　なし
'*****************************************************************************
Private Sub MergeRows2(ByRef objTopRow As Range, ByRef objBottomRow As Range)
Dim i As Long
Dim lngLast As Long

'最後のセルまで整備すれば終了する
lngLast = Cells.SpecialCells(xlCellTypeLastCell).Column

'1列毎にループ
For i = 1 To lngLast
'新しい行のセルが結合セルか
If objBottomRow.Cells(1, i).MergeCells = False Then
Call Range(objTopRow.Cells(1, i).MergeArea, objBottomRow.Cells(1, i)).Merge
End If
Next i
End Sub

返信する