Excelシート上で指定領域をオートフィルするVBAマクロ

バッチ・マクロのTOPへ

Excel VBAで，指定された領域をオートフィルするためのマクロ。

用途は前記事を参照。

サンプルコード

Sub FillRecord()
  ' 前提：
  '  3行1列目から横方向へカラム名が並んでいる
  '  1行5列目に，作成したいデータ数が並んでいる
  '  4〜5行目には差分のついたデータが入っている。いちばん左はID(開始IDは1でなくともよい)
  '  1行6〜7列目に進捗状況を表示する
  ' 見積もり：
  '  10カラム×100万レコードで2分くらい必要
  '  AutoFillメソッドを使わずにFor文で書き込むと死ぬほど時間がかかる（数千倍以上）
  
  ' 終端行をget
  Dim columnNum As Long
  columnNum = Cells(1, 5).Value
  If Not columnNum > 3 Then
      MsgBox "1行5列目にデータ数を入力してください"
      Exit Sub
  End If
  
  ' 開始時刻
  Dim d_begin As Date
  Dim d_end As Date
  d_begin = Time
  
  ' 行内終端をサーチ
  Dim nameColumn As Integer
  Dim i As Long
  Dim cname As String
  Dim rowNum As Integer
  nameColumn = 3
  i = 1
  Do While True
      cname = Cells(nameColumn, i).Value
      If (Len(cname) < 1) Then
          ' カラム名取得終わり
          rowNum = i - 1
          Exit Do
      Else
          ' 次の列へ
          i = i + 1
      End If
  Loop
  Cells(1, 6).Value = rowNum & "列あります。IDセット開始。。。"
  
  ' 1列目にIDをセット
  Range(Cells(4, 1), Cells(4, 1)).AutoFill Destination:=Range(Cells(4, 1), Cells(3 + columnNum, 1)), Type:=xlFillSeries
  
  ' 2列目以降をフィル
  Cells(1, 6).Value = "フィル中"
  Range(Cells(4, 2), Cells(columnNum + 3, rowNum)).FillDown
  
  ' 終了
  d_end = Time
  Cells(1, 7).Value = "(実行時間：" & DateDiff("s", d_begin, d_end) & "秒)"
  MsgBox "終了しました"
  Cells(1, 6).Value = " "
End Sub

コードの解説

実行に要した時間を毎回記録するようになっている。

こういった，手動でフィルした場合にはできないカスタマイズが可能になる点，マクロはおもしろい。

バッチ・マクロのTOPへ