VBAで自動的に指定範囲をAutoFillする方法

こんにちは、Ryoです。
VBAでデータを別ファイルに書込みしたりしていると、気が付けば余裕を持って作ったはずの様式の行数が不足してた!ということがありますよね。
その時にAutoFill機能を使って手動で下にずずーっと伸ばしたりしても良いのですが、
どうせVBA使うなら不足を察知して自動的に追加させてしまいましょう。
今回はそのサンプルコードをご紹介します。



1.Excelフォーム例

サンプルコードは以下のExcelフォームで連続的にデータを収集し記録されていくもの
として、SN(シリアルNo.)は既に連番としてある程度入力済みとします。

2.サンプルコード

◆SN検索に「Find」を使用する

そしてVBAで他シートや計測器等から必要なデータを収集し、本シートに書き込んだり
する訳ですが、その時にFindを使って「SN」を検索させて入力開始行を決めるように
しておきます。

'***Findを使って対象となるSNをファイル内から検索する***
    Set FndCellSN = Range("B:B").Find(What:=変数名又は配列名を指定))

    '//対象となるSNが無い場合、最終行を判定し500データ分を下にAutoFil実行//
    If FndCellSN Is Nothing Then
         Erflg = Erflg + 1
         '//SNCntUp⇒最終行からAutoFil実行して行の追加を行う処理PG//
         Call SNCntUp
           '//3回繰り返し=1500データ加算しても該当SNが無い場合、異常として終了//
           If Erflg = 3 Then
                MsgBox ("対象Sheetに該当するSNがありません"), vbCritical
                Exit Sub
            Else
              GoTo RT:
           End If
  

SNが入力されているB列全領域に対してFindを使って対象SNを検索させてます。
その時に既に入力されたSNが無い=最終行まで入力されたと判断して、AutoFillを実行する
サブプロシージャ(Call SNCntUp)を呼び出し処理します。

◆入力最終行から500データ分AutoFillを行う

最終行の判定を行い、行番号を取得してからAutoFill対象範囲を指定し
Selection.AutoFill Destination:=Range(Rp), Type:=xlFillSeries の部分で
AutoFillを実行します。

Sub SNCntUp()
'//対象となるSNが無い場合、最終行を検索して下方に500データ分AutoFilを行う//
 Dim LastRow, FillEndRow As Long
 
    'B列に対する入力最終行を抽出する
    LastRow = Cells(Rows.Count, 2).End(xlUp).Row
    '入力最終行からAutoFill処理分の500を加算
    FillEndRow = LastRow + 500
    'AutoFill対象の元範囲を指定
    Range(Cells(LastRow, 2), Cells(LastRow, 8)).Select
    '選択した範囲を500行分Autofill実行(Type:=xlFillSeriesでSNが連続データ)
    Selection.AutoFill Destination:=Range(Cells(LastRow, 2), _
    Cells(FillEndRow, 8)), Type:=xlFillSeries
    'AutoFill実行により生成された不要データを削除する(ここではC列、D列)
    Range(Cells(LastRow + 1, 3), Cells(FillEndRow, 4)).ClearContents

End Sub

この処理を追加しておけばFindで見つけられない場合に自動的に500データ分
追加されますので、ここの部分に関する気遣いが不要となりますね。他にもやり方は色々ありそうなので、このコード記述だけということは無いと思いますが一応機能はしますので良かったらお試しくださいませ。

以上が「VBAで自動的に指定範囲をAutoFillする方法」のご紹介でした。
何かのお役に立てれば幸いです。

Ryo

スポンサーリンク
スポンサーリンク

楽天トラベル

シェアする

フォローする

スポンサーリンク

楽天トラベル