セルの右下にカーソルを合わせたときに出る✚のコピー機能を、
オートフィル(フィルハンドル)と呼びます。
この機能、大変便利なのですがマウス専用なのが弱点で、
ショートカットキーがないためキーボードから実行することができません。
これをショートカットに登録するために、
フィルハンドルのコピー機能を再現したマクロを紹介します。
Ctrl+DやCtrl+Rと似た挙動のショートカットキーになるため、その近くでかつ、
初期設定のフラッシュフィルがいらない子のCtrl+Eに登録するのがおすすめです。
このマクロはExcel-Fun.xls*の勉強会「便利マクロ勉強会」において、
ゅぇ｡さんにご紹介いただいたマクロをアレンジしました。
便利なマクロを紹介いただきありがとうございました！
本勉強会の配信アーカイブがYoutubeにアップされており、
総勢7名の方から計70個の便利マクロが紹介されています。
各マクロのソースコードはコミュニティにアップロードされておりますので、
ぜひともご視聴いただき、ほしいマクロをお持ち帰りください。
◇ 各発表の資料とソースコードはこちら
Discordコミュニティ - Excel-Fun.xls*「便利マクロ勉強会」
マクロの仕様
まずはこの状態で実行すると、データの最終行までコピーを実行してくれます。
フィルハンドルのダブルクリックを再現した仕様ですね。
あとはちょっとしたカスタマイズを加えており、
ここで実行してもデータの最終行までコピーしてくれるようにしました。
本家は空列が入るとフィルできない仕様ですが、これを改良しています。
その他のカスタマイズポイントとして、
このような途中の値を無視するかどうかが挙げられます。
本家は途中に値があると止まってしまいますが、
これを変えて、上書きして最終行までコピーしてしまう仕様にもできます。
ただこちらは人によって好みが分かれるポイントかなと思いますので、
マクロの中でこの設定をON/OFFできるようにしてみました。
実装しておいてなんですが私はこの機能はOFFにしています。
（値があるのは何らかの異変なので引き返したい）
続いて、こちらはよりトリッキーなカスタマイズなのですが、
選択している行数によってフィルオプションの設定が変わる機能も付けました。
本家も「1,2まで入力してからフィルすると連続データ」になりますが、
この「2の入力」を省略しても連続データフィルを実行できるイメージですね。
ついでに「3行なら書式のみ」「4行なら値のみ」と、
無駄にフィルハンドルオプションの引数と連動させた設定にしました。
| 定数名 | 値 | 内容 |
|---|---|---|
| xlFillDefault | 0 | Excelによる自動判定 |
| xlFillCopy | 1 | セルのコピー |
| xlFillSeries | 2 | 連続データ |
| xlFillFormats | 3 | 書式のみコピー |
| xlFillValues | 4 | 書式なし(値のみ)コピー |
この手の隠し機能的な挙動は本当に好みが分かれるポイントで、
嫌いな人はとことん嫌いな気がします。
こちらもON/OFF機能を付けましたので、
使いたい方だけ冒頭のBoolean変数をTrueにしてください。
ソースコード
Sub 選択範囲からオートフィルを実行する() ' マクロの設定 Dim is途中の値を無視する As Boolean: is途中の値を無視する = False Dim is選択行数によってフィルハンドルオプションを切り替える As Boolean: is選択行数によってフィルハンドルオプションを切り替える = False If Selection.Areas.Count > 1 Then MsgBox "オートフィルは複数エリアを選択して実行できません。" Dim 選択範囲 As Range: Set 選択範囲 = Selection ' 選択セルからCurrentRegionの最終行までを取得 Dim 反映範囲 As Range Dim 表エリア As Range: Set 表エリア = 選択範囲.CurrentRegion Set 反映範囲 = Intersect(選択範囲.EntireColumn, 表エリア _ , 選択範囲.EntireRow.Resize(表エリア.Rows.Count)) ' 反映範囲が1行の場合は左側に存在するCurrentRegionを使用して取り直し If 反映範囲.Rows.Count = 1 Then Set 表エリア = 選択範囲.End(xlToLeft).CurrentRegion Set 反映範囲 = Intersect(選択範囲.EntireColumn, 表エリア.EntireRow _ , 選択範囲.EntireRow.Resize(表エリア.Rows.Count)) If 反映範囲.Rows.Count = 1 Then Exit Sub End If ' 反映範囲に値が存在した場合はそのひとつ前の行までに反映範囲を縮小 If is途中の値を無視する = False Then ' ただし反映範囲がすべて値で埋まっている場合は縮小しない If 反映範囲.Cells.Count <> WorksheetFunction.CountIf(反映範囲, "<>") Then ' 有値のセルを検索 Dim セル As Range For Each セル In 反映範囲.Cells ' 選択範囲の値は判定しない If Intersect(選択範囲, セル) Is Nothing Then If セル.Value <> "" Then Set 反映範囲 = Intersect(反映範囲, 反映範囲.Worksheet.Rows(1).Resize(セル.Row - 1)) Exit For End If End If Next End If End If If 反映範囲.Rows.Count = 1 Then Exit Sub 反映範囲.Select ' 選択行数によってフィルハンドルオプションを切り替える設定の場合 If is選択行数によってフィルハンドルオプションを切り替える Then Select Case 選択範囲.Rows.Count Case 1 ' 通常のコピー 選択範囲.Rows(1).AutoFill 反映範囲, xlFillCopy Case 2 ' 連続データ 選択範囲.Rows(1).AutoFill 反映範囲, xlFillSeries Case 3 ' 書式のみ 選択範囲.Rows(1).AutoFill 反映範囲, xlFillFormats Case 4 ' 値のみ 選択範囲.Rows(1).AutoFill 反映範囲, xlFillValues End Select ' 行数切替を用いない場合は、1行選択の場合はコピー ElseIf 選択範囲.Rows.Count = 1 Then 選択範囲.AutoFill 反映範囲, xlFillCopy ' 複数行選択の場合はExcelの予測でコピー/連続データを切り替え Else 選択範囲.AutoFill 反映範囲, xlFillDefault End If End Sub
解説
各コードの処理は基本的な処理の組み合わせのため割愛します。
選択セルを起点とした表エリアを取得するCurrentRegionを用いて、
選択セルから表エリアの最終位置までのセル範囲を取得しています。
こういったコードはIntersectが大活躍しますね。
たいした処理は行っていないのですが、
途中に値があるか、表から離れている位置で実行されているかなど、
選択範囲に実行する系のマクロは分岐が多くてコードが長くなりがちです。
適当な変数名を付けていると訳が分からなくなりますのでご注意ください。
再掲となりますが、このマクロはExcel-Fun.xls*の勉強会「便利マクロ勉強会」において、ゅぇ｡さんにご紹介いただいたマクロをアレンジしました。
便利なマクロを紹介いただきありがとうございました！
本勉強会の配信アーカイブがYoutubeにアップされており、
総勢7名の方から計70個の便利マクロが紹介されています。
各マクロのソースコードはコミュニティにアップロードされておりますので、
ぜひともご視聴いただき、ほしいマクロをお持ち帰りください。
◇ 各発表の資料とソースコードはこちら
Discordコミュニティ - Excel-Fun.xls*「便利マクロ勉強会」
◇ Discordのご参加がまだの方はこちら
www.limecode.jp
