今回説明するのは、セルの参照範囲を変更する事ができるResizeプロパティの利用方法を説明いたします。このResizeプロパティは、引数に指定した行数・列数を指定することで、参照範囲を変更する事が出来ます。Offsetプロパティと組み合わせることで、表全体から見出し行を除いた参照範囲を指定する事が出来ます。
●【Offsetプロパティに関する内容は、下記の参照して下さい】
● Resizeプロパティを利用するには、下記の通りに設定を行います。
※基準セルの位置を元に、行方向の桁数と列方向の列数を指定します。
| 引数 | 必須・省略可能 | 内容（説明） |
|---|---|---|
| RowSize | 省略可能 | 変更後の行数を指定します。省略した場合は、行数は変わりません。 |
| ColumnSize | 省略可能 | 変更後の列数を指定します。省略した場合は、列数は変わりません。 |
【使用例①】：セル[A1]を起点に縦２×横２を選択
'
Sub Resize00A() 'Resizeの使用例（サンプル）
Range("A1").Resize(2, 2).Select
'セル[A1]を起点に縦２×横２を選択
End Sub
' 【実行後】
※A１⇒A1：B2のセルが範囲選択されました。（背景色は範囲選択のイメージです。）
【使用例②】：セル[A1]を起点にOffset(1,0)でA2へ、A2を起点に縦5×横5を選択
'
Sub Resize00B() 'Resize+Offsetの使用例（サンプル）
Range("A1").Offset(1, 0).Resize(5, 5).Select
'セル[A1]を起点にOffset(1,0)でA2へA2を起点に縦5×横5を選択
End Sub
' 【実行後】
※A１⇒A２⇒A2：E５のセルが範囲選択されました。（背景色は範囲選択のイメージです。）
【使用例③】：セル[A1]を起点にOffset(0,1)でB1へB1を起点に縦10×横3を選択
Sub Resize00C() 'Resize+Offsetの使用例（サンプル）
Range("A1").Offset(0, 1).Resize(10, 3).Select 'セル[A1]に移動
'セル[A1]を起点にOffset(0,1)でB1へB1を起点に縦10×横3を選択
End Sub
' 【実行後】
※A１⇒B１⇒B1：D10のセルが範囲選択されました。（背景色は範囲選択のイメージです。）
【使用例④】：セル[A1:D4]を起点に、セル[A1:D２]が選択（１～２行分が選択）
'
Sub Resize00D() 'Resizeの使用例（サンプル）
Range("A1:D4").Resize(2).Select
'セル[A1:D4]を起点に2行が選択さました。
End Sub
' 【実行後】
※セル「A１：D４」⇒「A1：D2」のセルが範囲選択されました。（背景色は範囲選択のイメージです。）
【使用例⑤】：セル[A1:D4]を起点に、1列目[A1:A４]が選択（１列が選択）
'
Sub Resize00E() 'Resizeの使用例（サンプル）
Range("A1:D4").Resize(, 1).Select
'セル[A1:D4]を起点に１列目が選択さました。
End Sub
'
下記のサンプルプログラムは、Resizeプロパティを利用して表のサイズを自動に取得して、見出し行を除いたデータ部分のみのセル範囲を別シートに複写（コピー）するサンプルプログラムです。
【プログラムの流れ】
① ワークシート「社員情報」・「複写データ」を設定
② 転記先のワークシート「複写データ」のデータをクリアーします。
③ ワークシート「社員情報」の表全体を参照します。
④ 1行目の見出し行を除いて、表の最終行までコピーする。
⑤ ワークシート「複写データ」に見出し行を除いて全てのデータを貼り付けます。
【プログラム実行条件】
① ワークシート「社員情報」・・・・社員データを登録します。
② ワークシート「複写データ」・・・ワークシートのみ作成します（空白）
'
''******** AKIRA55.COM ******* https://akira55.com/resize/
'
Sub Resize01() 'Resize+CurrentRegion 見出し以外のデータを別シートに転記します。
Dim ws01, ws02 As Worksheet
Dim lRow As Long
Set ws01 = Worksheets("社員情報") 'ワークシート「社員情報」を設定
Set ws02 = Worksheets("複写データ") 'ワークシート「複写データ」
ws02.Cells.ClearContents '転記先のワークシート「複写データ」をクリアーします。
With ws01.Range("A1").CurrentRegion 'ワークシート「社員情報」の表全体を参照する。
.Offset(1).Resize(.Rows.Count - 1).Copy '1行目の見出し行を除いて、表の最終行までのコピーする。
End With
ws02.Range("A1").PasteSpecial xlPasteValues 'ワークシート「複写データ」に見出し行を除いて全てのデータを貼り付けます。
End Sub
'
下記のサンプルプログラムは、検索値を入力して該当するデータに対してResizeプロパティを使いセルの範囲を広げて、別のワークシートに複写するサンプルプログラムです。
【詳細説明】
社員情報に社員番号を含めたデータ一覧が作成されています。この社員番号を数値で入力して、該当する社員番号があれば、別シート「複写データ」に転記します。
【プログラムの流れ】
① ワークシート「社員情報」・「複写データ」を設定
② ワークシート「社員情報」の最終行を取得します。
③ ワークシート「複写データ」の最終行を取得します。
④ 複写する社員番号を入力します。
⑤ 入力した社員番号に該当データが有れば別シート「複写データ」に該当データを転記します。
⑥ 該当したデータが無ければ、「有りません」のメッセージを表示します。
⑦ 社員番号「9999」を入力されるまで繰り返します。③へ
【プログラム実行条件】
① ワークシート「社員情報」・・・・社員データを登録します。
② ワークシート「複写データ」・・・転記先の表をを作成します。
③ ワークシート「社員情報」・・・A列の「社員番号」は、数値のみで登録します。
'
''******** AKIRA55.COM ******* https://akira55.com/resize/
'
Sub Resize02() 'Resize+Match関数で該当したのデータを別シートに転記します。
Dim ws01, ws02 As Worksheet
Dim L, lRow, mRow, xRow, NameNo As Long
Set ws01 = Worksheets("社員情報") 'ワークシート「社員情報」を設定
Set ws02 = Worksheets("複写データ") 'ワークシート「複写データ」を設定
lRow = ws01.Cells(Rows.Count, "A").End(xlUp).Row 'ワークシート「社員情報」A列の最終行を取得します。
Do
xRow = ws02.Cells(Rows.Count, "A").End(xlUp).Row 'ワークシート「複写データ」A列の最終行を取得します。
NameNo = Application.InputBox(Prompt:="社員番号を数値で入力してください！", Title:="社員情報", Type:=1)
'選択する社員番号を数値で入力します。
mRow = 0
On Error Resume Next 'エラー回避（Match関数の場合は、該当データがないとエラーが発生するので設定する）
mRow = WorksheetFunction.Match(NameNo, ws01.Range("A2:A" & lRow), 0) + 1
'InputBox関数で入力した社員番号がワークシート「社員情報」のA列「社員番号」にあるか検索します。
'該当する社員番号が有る場合は、行番号を返します。ない場合は、そのままゼロを返します。
On Error GoTo 0 'エラー発生した場合もそのまま続行
If mRow = 0 Then
MsgBox "入力した社員番号のデーターが有りませんでした。" '該当データが無い場合
Else
ws01.Range("A1").Offset(mRow - 1).Resize(, 6).Copy
'該当した社員番号（行番号）からResizeでF列（６）まで選択範囲を広めて、該当列をコピーします。
ws02.Cells(xRow + 1, "A").PasteSpecial xlPasteValues
'ワークシート「複写データ」へ該当データが貼り付けられます。
End If
Loop While NameNo <> 9999 ''社員番号を9999入力したら終了する。社員番号9999以外は繰り返す。
End Sub
'
