VBAで文字入力されている行の上に複数行追加する方法 | 変数で行数指定

エクセルの表を印刷してみるために、見やすくするよう部署ごとに3行の空白を挿入してほしいという要望がありました。他にも方法がありますが、要望通り再現しましたのでその方法を紹介します。

この方法では、A列に部署名が入力されている前提で、各部署ごとにその部署名の上に指定された行数(ここでは3行)の空白行を挿入します。これにより、見栄えの向上や特定のレイアウト要件に対応できます。

目次

VBAでの行挿入の基本

VBAを使用してExcelで行を挿入するには、RowsオブジェクトとInsertメソッドを使用します。

基本

次はアクティブなシート(現在選択されているシート)に行を挿入します。この形式は、アクティブなシートでのみ機能するため、シートを切り替える必要がない場合や、明示的なシートの指定が不要な場合に使用できます。

Rows(挿入位置).Insert

特定のシートに対して行を挿入する場合は、シート名を指定します。異なるシートに対して操作を行う場合や、シートの切り替えが必要な場合に使用します。

対象シート.Rows(挿入位置).Insert

1行挿入をする

2行目の上に新しい行を挿入し、2行目以降のデータが下方向に1行ずつシフトする例です。

Rows(2).Insert

複数行を挿入をする

2行目から5行目の上に新しい行を挿入し、既存のデータを下方向にシフトする例です。

Rows("2:5").Insert

文字が入力されている行の上に複数行挿入する例

エクセル一覧

データの再利用を考えるのであれば、A列にはこのようにすべて部署名を入力すべきです。しかし、印刷して見やすい表を優先してほしいとのことで、渡されたエクセル一覧は部署名がすべてのセルに入力されていませんでした。

変更前の一覧表

エクセル・行挿入前

変更前のエクセル一覧表は、その部署の1行目のみに部署名が入力されていました。

変更後の一覧表

エクセル一覧表に文字の上に行挿入

部署名の上に3行挿入してほしいという依頼。

エクセル一覧表のA列に複数行挿入したい

実際の一覧表はデータ量が多く、手作業では大変です。

変数で行数を指定して挿入するコード

追加したい行数は、変数で指定する方法です。

2行目の上に挿入した行の書式設定無視

Sub RowsInsert1()
Dim gyo As Long
    Dim i As Long
    Dim lastRow As Long

    gyo = 3                                         '挿入したい行数
    lastRow = Cells(Rows.count, 1).End(xlUp).Row     'A列最終行

    Application.ScreenUpdating = False

    For i = lastRow To 2 Step -1
        If Cells(i, 1).Value <> "" Then
            Rows(i & ":" & i + gyo - 1).Insert
        End If
    Next i

    Application.ScreenUpdating = True
End Sub
説明
  • 6行目:「gyo」変数で挿入する行数を指定します。この例では3行の行を挿入します。
  • 7行目:「lastRow」変数でA列の最終行を取得します。Cells(Rows.Count, 1).End(xlUp).Row は、A列の下から上に向かって空白のセルを検索し、その行番号を返します。
  • 9行目:「Application.ScreenUpdating = False」で画面の更新を一時的に無効にします。これにより、処理が実行される際に画面がちらつくのを防ぎ、処理が速くなります。
  • 11~15行目:For ループで最終行から2行目まで、逆順でループします。
  • 12~14行目:If ステートメント:で各行のA列が空でない場合に、その行から変数「gyo」行分の範囲を挿入します。
  • 17行目:「Application.ScreenUpdating = True」で画面の更新を再度有効に戻します。

この例では、項目名の1行目に書式設定をしていると、挿入した行もその書式設定になります。

2行目の上に挿入した行の書式設定考慮

Sub RowsInsert2()
    Dim gyo As Long
    Dim i As Long
    Dim lastRow As Long
    Dim originalFormat As Range

    gyo = 3                                          '挿入したい行数
    lastRow = Cells(Rows.count, 1).End(xlUp).Row     'A列最終行

    Application.ScreenUpdating = False

    For i = lastRow To 2 Step -1
        If Cells(i, 1).Value <> "" Then
            ' 2行目の書式を保存
            If i = 2 Then
                Set originalFormat = Rows(i).EntireRow
            End If
            Rows(i & ":" & i + gyo - 1).Insert
            ' 2行目の書式を復元
            If i = 2 Then
                originalFormat.Copy
                Rows(i & ":" & i + gyo - 1).PasteSpecial Paste:=xlPasteFormats
                Application.CutCopyMode = False
            End If
        End If
    Next i
    Application.ScreenUpdating = True
End Sub
目次