サポート掲示板


 新規投稿 | タイトル一覧 - ツリー - スレッド - 投稿一覧 | 検索 | 設定 


[38] 修正メモ
Name: takana
Date: 2010/03/18 17:06
'*****************************************************************************
'[ 関数名 ] 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

返信する


関連ツリー
-修正メモ [takana] (2010/03/18 17:06)

 返信フォーム [引用]

 名前 *
 E-Mail
 題名 *

タグ使用可 <b><i><s><font>
 URL
 Pass  設定すれば、投稿後に削除や編集ができます


Pass

トップページへ

レッツPHP!