VBEのオプションとは？開き方と4つのタブ

VBE(Visual Basic Editor)は、ExcelやWordでマクロを書くための専用エディタです
その動作や見た目をまとめて調整できるのが、メニューの「ツール → オプション」から開くオプションダイアログになります

先に結論を言うと、ここを最初に少し整えておくだけで、後々のミスや「なんか書きにくいな」というストレスがかなり減ります
とくに初心者のうちは、打ち間違いに気づけない状態が一番こわいので、その対策になる設定が用意されているのは知っておいて損がないです

まずはVBEを開くところから確認しておきましょう
ExcelでVBEを呼び出すショートカットは Alt + F11 です

オプションダイアログは、上部のタブで4つの画面に分かれています
それぞれ役割が違うので、ざっくり何のタブかをつかんでおきましょう

英語名は Editor ですが、日本語版の画面では「編集」タブと表示されます(Editor=エディター、と思うとズレるので注意してください)

なお、この記事は Windows版のExcel を前提にしています
VBEのオプション構成はExcel 2016〜365で基本的に同じですが、Mac版はオプション画面の構成や一部設定の効き方が違い、この記事のとおりにいかないことがあります

ジャベ雄

4タブ全部を完璧に覚える必要はないです、要所だけ押さえれば十分です

最重要：「変数の宣言を強制する」でtypoバグを防ぐ

最初に、この記事で一番おすすめしたい設定からいきます
編集タブの中にある 変数の宣言を強制する(Require Variable Declaration) です

結論から言うと、この設定をONにすると、新しく作るモジュールの先頭に Option Explicit という1行が自動で入るようになります
このひと手間が、初心者がやりがちな打ち間違いバグを大きく減らしてくれます

なぜtypo(打ち間違い)がバグになるのか

VBAは初期状態だと、宣言していない変数名をいきなり書いても、その場で勝手に新しい変数として扱ってくれます
一見やさしい仕様ですが、これが打ち間違いを見逃す原因になります

たとえば kingaku という変数に金額を入れていたのに、途中で kinaku と打ち間違えたとします
すると VBA は「kinaku は新しい変数だな」と判断して、空っぽのまま処理を続けてしまいます

エラーにもならず、ただ計算結果だけがおかしくなる
これがいわゆる「動くのに答えが合わない」厄介なバグで、原因探しに何時間も溶かすこともあります

Option Explicit が打ち間違いを止めてくれる

そこで効いてくるのが Option Explicit です
これはモジュールの先頭に書く宣言で、「使う変数はすべて先に宣言しておいてね」というルールをVBAに守らせます

このルールが効いていると、宣言していない kinaku を書いた瞬間にエラーで止まってくれます
つまり、答えが合わなくなってから悩むのではなく、書いた直後に「あ、打ち間違えた」と気づけるわけです

変数の宣言を強制する設定は、この Option Explicit を毎回手で書かなくても、新しいモジュールに自動でつけてくれる便利機能だと考えてもらえると分かりやすいです

ジャベ雄

私はこれを入れてから、変数まわりの謎バグでハマる回数がはっきり減りました

Option Explicit そのものの意味や、変数の宣言(Dim)の書き方をもっと深く知りたい方は、別記事でじっくり解説しています
あわせて読むと、なぜこの設定が効くのかが腑に落ちると思います

→ VBAの変数と定数の使い方(Option Explicitの意味も解説)

注意：効くのは「新規モジュール」だけ

ここがいちばん勘違いされやすいポイントです
変数の宣言を強制するをONにしても、すでに作ってあるモジュールには Option Explicit は入りません

この設定で自動挿入されるのは、あくまでこれから新しく作るモジュールだけです
マイクロソフトの公式リファレンスでも、追加されるのは「any new module(新しいモジュール)」と明記されています

といっても、やることは難しくありません
既存モジュールのコードの一番上に Option Explicit と1行打つだけで、そのモジュールにも同じルールが効くようになります

エディタータブ：入力補助とタブ幅のおすすめ

続いて、同じ編集(Editor)タブにある残りの項目を見ていきます
結論としては、入力補助はほぼ全部ONのままが快適で、タブ幅だけ好みで調整する、というのが初心者向けのおすすめです

編集タブの設定は、ざっくり「入力を助けてくれる系」と「画面の見せ方系」に分かれます
まずは入力を助けてくれる系から、表でまとめて整理します

入力補助系はONのままが快適

自動メンバー表示・自動クイックヒント・自動インデントは、コードを書くスピードと正確さを上げてくれる機能です
初期状態でONになっていることが多いので、基本はそのままで問題ありません

ひとつ補足しておきたいのが 自動データヒント(Auto Data Tips) です
これは変数にマウスを乗せると値が見える機能ですが、いつでも見えるわけではなく、ブレークモード(処理を一時停止したデバッグ中)のときだけ使えます

「ONにしたのに値が出ない」と感じたら、それはマクロが止まっていないからかもしれません
F8キーで1行ずつ実行している最中などに試すと、ちゃんと値が表示されます

自動構文チェックはOFFも検討の余地あり

自動構文チェック(Auto Syntax Check)は、1行入力するたびに文法をチェックして、ミスがあると警告ダイアログを出してくれる機能です
ありがたい機能ではあるのですが、人によっては「入力の途中で何度も警告が出てうっとうしい」と感じます

そこでよく出てくるのが「OFFにすると、エラーに気づけなくなるのでは？」という心配です
ここはよくある誤解なので整理しておきます

つまりOFFにしても、ミスのある行は色で見分けられるので気づけます
ダイアログのわずらわしさが気になる方はOFF、最初のうちは警告で気づきたい方はONのまま、と好みで選んで大丈夫です

※この赤字が残る挙動は環境によって見え方が変わることもあるので、気になる方は一度ご自身のVBEで試してみてください

タブ幅と画面の見せ方

編集タブには、コードの見せ方を決める項目もあります
初心者がとくに気にすると良いのは タブ幅(Tab Width) です

タブ幅は、Tabキーで字下げするときの空白の量で、既定は4、設定できる範囲は1〜32 です
既定の4のままでも問題なく、深い入れ子で右に寄りすぎると感じるなら2に下げる、といった調整ができます

そのほか、画面の見せ方に関わる項目も軽く触れておきます
下の表は、知っておくと迷わない補助的な設定です

ひとつだけ補足です
モジュール全体を表示(Default to Full Module View)は、あくまでこれから開く新規モジュールの既定を決める設定で、今まさに開いている画面の見え方は変えません

ジャベ雄

区切り線はオンにしておくと、プロシージャの切れ目が一目で分かって便利です

VBAの独学に効く本PR

Excel VBA塾【動画×本で学ぶ!】

たてばやし淳

Amazonで見る楽天で見る

パーフェクトExcel VBA

高橋宣成

Amazonで見る楽天で見る

Excel マクロ&VBA［実践ビジネス入門講座］完全版 第3版

国本温子

Amazonで見る楽天で見る

私のおすすめからランダムで3冊を表示しています

エディターの設定タブ：フォントと色でコードを見やすく

次は「エディターの設定(Editor Format)」タブです
ここはコードの見た目、つまりフォントや色を整える画面で、長時間コードを書く人ほど効いてきます

フォントは等幅がおすすめ

コードを読むときは 等幅フォント(全部の文字が同じ幅で並ぶフォント)が見やすいです
桁がきれいにそろうので字下げが読み取りやすく、数字の0とアルファベットのO、小文字のlと数字の1なども見分けやすくなります

逆に比例フォント(文字幅がバラバラのフォント)だと字下げの位置がガタついて、入れ子の深さを目で追いにくくなります

日本語版のExcelだと、既定のフォントは MS ゴシック になっていることが多いです
これも等幅フォントなので無理に変える必要はありませんが、好みで Consolas などに変えても読みやすくなります

色分けと余白インジケーターバー

このタブでは コードの色分け(Code Colors) も調整できます
キーワード・コメント・エラー行など、テキストの種類ごとに前景色(文字色)や背景色を決められます

初心者のうちは初期設定のままで十分ですが、コメントの色を少し目立たせると、説明書きとコードの区別がつきやすくなります
暗い背景にしたい人は、ここで文字色と背景色を反転させる調整もできます

もうひとつ、余白インジケーターバー(Margin Indicator Bar) という項目もあります
これはコードウィンドウの左端に出る帯の表示・非表示を切り替えるもので、この帯にブレークポイントなどのマークが出ます

デバッグ(処理を止めて中身を確認する作業)でよく使う場所なので、基本は表示したままがおすすめです

全般タブ：エラーのトラップを知っておく

「全般(General)」タブで初心者がいちばん知っておくと良いのが エラーのトラップ(Error Trapping) です
これは、マクロ実行中にエラーが起きたとき「どこで処理を止めるか」を決める設定で、デバッグのしやすさに直結します

エラーのトラップ 3つのモード

エラーのトラップには3つのモードがあります
違いを表でつかんでおきましょう

通常は エラー処理対象外のエラーで中断(Break on Unhandled Errors) になっていることが多いです
これが既定なので、普段づかいではこの状態のままで問題ありません

覚えておくと便利なのが すべてのエラーで中断(Break on All Errors) の使いどころです
On Error などのエラー処理を書いていると、エラーがあっても素通りしてしまい、どこで失敗したのか分かりにくくなることがあります

そんなときは 一時的にすべてのエラーで中断に切り替えると、エラーが起きた行でピタッと止まるので原因を特定しやすくなります
原因が分かったら元に戻す、という使い方が定番です

ジャベ雄

原因不明のバグに詰まったら、この切り替えを思い出すと助かります

コンパイルと状態の通知は軽く知っておく

全般タブには、コンパイル(コードを実行できる形に変換する処理)に関する項目もあります
初心者がいじる場面は少ないので、ここは軽く知っておく程度で十分です

• 要求時コンパイル(Compile On Demand) … 実行に必要な部分だけ先にコンパイルして、起動を早める
• バックグラウンドコンパイル(Background Compile) … 空き時間に残りをコンパイルする(要求時コンパイルがONのときだけ有効)

バックグラウンドコンパイルは、要求時コンパイルがONになっていないと使えないという依存関係があります
どちらも基本は初期設定のままで困りません

もうひとつ、状態を失う前に通知(Notify Before State Loss) という項目もあります
これは、実行中のマクロを編集したせいで変数の中身がすべてリセットされる前に、確認メッセージを出すかどうかの設定です

ドッキングタブと設定の保存先の話

最後のタブが「ドッキング(Docking)」です
ここは、VBE内の各ウィンドウを画面の端に固定するかどうかを、チェックボックスで選ぶ画面になります

ドッキングタブでウィンドウの居場所を整える

ドッキングとは、ウィンドウをVBEの端にピタッとくっつけて固定する状態のことです
プロジェクトエクスプローラーやプロパティウィンドウ、イミディエイトウィンドウなどを、それぞれ固定するかどうか選べます

固定をやめると、ウィンドウを自由に動かせるフロート状態になります
「ウィンドウがどこかに行って戻せない」というときは、このタブのチェックを見直すと整いやすいです

設定はExcelとWordで共通になりやすい

まず安心してほしいのが、一度変えた設定はExcelを閉じても残るという点です
毎回やり直す必要はなく、変な設定にしてしまっても同じ画面でいつでも戻せます(再起動もいりません)

もうひとつ、知っておくと混乱しない小ネタです
VBEのオプションは、Excelごと・Wordごとに別々ではなく、VBAの仕組み側にひも付く傾向があります

そのため、ExcelのVBEで変えた設定が、WordのVBEを開いたときにも同じように効いていることが多いです
「片方で整えたのに、もう片方では設定し直し」とはなりにくい、と考えておくと良いです

まとめ：VBEおすすめ設定の早見表とよくある質問

ここまでのおすすめ設定を、冒頭で予告した7つとして早見表にまとめます
まずは主役の「変数の宣言を強制する」をONにするところから始めれば十分です

VBAの基礎をもっと固めたい方は、変数の使い方やループ処理の記事もあわせてどうぞ
設定を整えたあとは、書くコード自体の引き出しを増やしていくのが上達の近道です

• VBAの変数と定数の使い方(Option Explicitの意味を深掘り)
• VBAのループ処理 ForとDoの違いと使い分け

VBEのオプションは、一度整えてしまえば毎回設定し直す必要がありません
まずは変数の宣言を強制するをONにして、打ち間違いバグの少ない環境から始めてみてください

VBAの独学に効く本PR

Excel VBA塾【動画×本で学ぶ!】

たてばやし淳

Amazonで見る楽天で見る

パーフェクトExcel VBA

高橋宣成

Amazonで見る楽天で見る

Excel マクロ&VBA［実践ビジネス入門講座］完全版 第3版

国本温子

Amazonで見る楽天で見る

私のおすすめからランダムで3冊を表示しています

「VBAでJSONを読み込みたいんだけど、標準機能だとどうにもならない…」と手が止まっていませんか？

結論から言うと、ExcelVBAでJSONを扱うなら「VBA-JSON」という定番ライブラリを入れるのが一番ラクです

やることはシンプルで、JsonConverter.bas というファイルを1つ取り込んで、参照設定を1つ入れるだけ、あとは ParseJson でJSONを読み込んで、ConvertToJson でJSONを書き出せます

この記事では、VBA-JSONの導入から実際の使い方(パース・生成・配列やネストへのアクセス・ループ処理)まで、初心者の方にも分かるように順を追って解説していきます、つまずきポイントとFAQ、AIにコードを書いてもらうコツもまとめているので、必要なところだけ拾い読みでも大丈夫です

VBAでJSONを扱うなら VBA-JSON が定番

まず大前提として、VBAには標準でJSONを扱う機能がありません

Excelには CSV を読む機能はあっても、JSONをそのまま「項目ごとに取り出す」みたいなことは素のVBAだとできないんですよね

そこで使うのが、オープンソースのライブラリ「VBA-JSON」です

GitHubの VBA-tools/VBA-JSON で公開されていて、JSON界隈ではかなり知られた定番です、最新は v2.3.1 で、WindowsのExcelでもMacのExcelでも動きます

使う関数は基本的にこの2つだけ覚えればOKです

• ParseJson … JSON文字列を、VBAで扱えるデータ(Dictionary / Collection)に変換する(=読み込む)
• ConvertToJson … VBAのデータを、JSON文字列に変換する(=書き出す)

「読み込む」と「書き出す」の往復、これだけです、難しそうに見えて中身はシンプルなので安心してください

VBAでJSONを扱う場面はどんなとき？

そもそも「ExcelでJSONなんて使うの？」と思うかもしれませんが、最近のWeb APIはJSONで返ってくるのがほぼ標準なので、意外と日常業務の中で出番があります

たとえばこんなケースです

• 為替レートや天気予報のWeb APIを叩いてExcelに取り込む
• WebサービスからダウンロードしたデータをVBAで集計する
• 取引先のシステムとJSON形式でデータをやり取りする
• WordPressや社内システムのREST APIを操作する

VBA-JSONを使えるようになると、Excel完結の作業に外部データを取り込める幅が一気に広がります、普段の集計シートに「最新のデータを自動で引っ張ってくる」ような仕組みを足せるイメージですね

実際にWeb APIへリクエストを送ってJSONを受け取る流れは、eBay APIにVBAでリクエストを送る方法を解説した記事でも具体例を扱っているので、API連携をやってみたい方はあわせてどうぞ

そもそもJSONって何？という人向けの基礎

「JSONって言葉は聞くけど、よく分かってない」という方のために、ここで一度ざっくり整理しておきます、もう分かってる方は読み飛ばしてOKです

JSON(JavaScript Object Notation)は、テキストベースのデータ交換フォーマットです

Web APIからデータを取得するとき、他システムとのデータやり取りなど、いろんな場面で使われています、軽量で人間にも機械にも読みやすいのが特徴ですね

JSONの基本構造と記述ルール

細かいルールはいくつかありますが、まず押さえておきたいのはこのあたりです

• 項目名は「”」(ダブルクォーテーション)で囲む
• 文字列も「”」(ダブルクォーテーション)で囲む
• 数値は小数点を含めてそのまま表記(クォーテーション不要)
• 真偽値(Boolean)は「true」「false」のどちらか ※小文字、「”」は付けない
• Null値は「null」 ※小文字、「”」は付けない
• 「[ ]」で囲んだ配列の中も、上記と同じルール

形としては「"キー": 値」のセットが基本で、複数のデータを { } で囲んだものを「オブジェクト」、順序のあるデータの並びを [ ] で囲んだものを「配列」と呼びます

このあたりの言葉は、VBA-JSONを使うときに何度も出てくるので、なんとなく頭に入れておくと後がスムーズです

JSONのサンプルをExcelの表で考えてみる

JSONはCSVほど一目で分かる形式じゃないので、サンプルと一緒に見方を説明します、この記事ではずっとこのデータを例に進めていきます

たとえばこんなJSON形式のデータがあるとして

[{"name":"Javeo","birthdate":{"year":2000,"month":1,"day":1},"height":180,"weight":70,"favorite_foods":["Meat","Vegetables"],"glasses":true},{"name":"Javelin","birthdate":{"year":2002,"month":2,"day":2},"height":150,"weight":null,"favorite_foods":["Sweets"],"glasses":false}]

一行だと分かりづらいので、整形するとこうなります(VSCodeなどのエディタで簡単に整形できます)

[
  {
    "name": "Javeo",
    "birthdate": {
      "year": 2000,
      "month": 1,
      "day": 1
    },
    "height": 180,
    "weight": 70,
    "favorite_foods": [
      "Meat",
      "Vegetables"
    ],
    "glasses": true
  },
  {
    "name": "Javelin",
    "birthdate": {
      "year": 2002,
      "month": 2,
      "day": 2
    },
    "height": 150,
    "weight": null,
    "favorite_foods": [
      "Sweets"
    ],
    "glasses": false
  }
]

これをExcel的に表にすると、こんなイメージになります

つまりJSONをざっくり言うと、項目と値が対になっていて、「{ }」が階層を、「[ ]」が配列のデータ群を表していると思えばOKです

この「JaveoとJavelinの2人分のデータ」を、これからVBA-JSONで取り出していきます

VBA-JSONの導入手順(2026年版)

ここが一番大事なパートです、導入でつまずく人が多いので、順番にやっていきましょう

やることは大きく分けて2つ、「JsonConverter.basのインポート」と「参照設定」だけです

STEP

ライブラリのダウンロード

GitHubのVBA-tools/VBA-JSONリポジトリにアクセス

STEP

ファイルを探す

ページ内にある「JsonConverter.bas」をダウンロード

※何年も更新されていませんが、文字列を分解するだけのプログラムで特に改良点がないってだけなので気にせずどうぞ

STEP

VBAへのインポート

VBAで使えるようにするにはVBEの画面でインポートするだけ

プロジェクトエクスプローラー
右クリック→「ファイルのインポート」

もしくは「JsonConverter.bas」をプロジェクトエクスプローラーへドラッグ&ドロップでもOK

STEP

Microsoft Scripting Runtime に参照設定する

VBA-JSONを動かすには参照設定が要ります

VBA-JSONは内部で「Dictionary」という、キーと値をセットで扱うデータの入れ物を使っています、このDictionaryをそのまま書くスタイル(早期バインディングと言います)で動かすために、Microsoft Scripting Runtime への参照設定が必要になります

設定はVBEのメニューからで、手順はこうです

1. VBEのメニューで「ツール → 参照設定」を開く
2. 一覧から「Microsoft Scripting Runtime」を探す
3. チェックボックスにチェックを入れて「OK」を押す

これを忘れると、コードを実行したときに「ユーザー定義型は定義されていません」というエラーが出ます、後ろのFAQでも触れますが、この参照設定はかなりの確率でハマるので先に済ませておくのがおすすめです

Mac の Excel で使う場合

MacのExcelには Microsoft Scripting Runtime が無いので、参照設定の代わりに同じ作者の「VBA-Dictionary」というライブラリを一緒に入れます

VBA-tools/VBA-Dictionary から Dictionary.cls をダウンロードして、JsonConverter.bas と同じようにインポートすればOKです、WindowsとMacの両方で動かしたいときも、参照設定ではなくこのVBA-Dictionaryを使う形にしておくと安心ですね

ここまでできたら準備は完了です、いよいよ実際にJSONを扱っていきます

ParseJson でJSONを解析(パース)してみる

JSON形式のテキストを、VBAで扱えるデータ構造(DictionaryやCollection)に変換することを「解析(パース)」と言います

このパースが、ParseJson 関数を使えばたった一行で完了します

まずはWeb APIからJSONを取ってきてパースする、いちばんよくある形のサンプルです

' /// 事前準備 ///
' VBEの [ツール] > [参照設定] から下記にチェックを入れる
' ・Microsoft Scripting Runtime   (Dictionary用、VBA-JSONに必須)
' ・Microsoft XML, v6.0           (APIを叩く場合)
Sub GetJsonData()
    Dim http As Object
    Dim jsonText As String
    Dim parsedData As Object ' 解析後のデータ格納用

    ' Web APIからJSONデータを取得(例)
    Set http = CreateObject("MSXML2.XMLHTTP")
    http.Open "GET", "https://javeo.jp/wp-json/test/v1/data", False
    http.send
    jsonText = http.responseText

    ' ここがVBA-JSONの本体、JSONを解析
    Set parsedData = ParseJson(jsonText)

    ' 解析したデータをデバッグ出力
    Debug.Print "名前: " & parsedData(1)("name")
    Debug.Print "身長: " & parsedData(1)("height")

    Set http = Nothing
    Set parsedData = Nothing
End Sub

長く見えるかもしれませんが、VBA-JSONを使っている箇所は、結局このたった一行だけです

Set parsedData = ParseJson(jsonText)

この一行を通すことで、最初のサンプルにあった「長いただの文字列」が、parsedData(1)("name") といった具合に要素を指定してデータを取り出せる構造に変わります

APIを使わず、手元の文字列をそのままパースして試すこともできます、まずは動きを確かめたいときはこちらが手っ取り早いです

Sub ParseSample()
    Dim jsonText As String
    Dim parsedData As Object

    ' 動作確認用に文字列を直接用意
    jsonText = "[{""name"":""Javeo"",""height"":180}]"

    Set parsedData = ParseJson(jsonText)

    Debug.Print parsedData(1)("name") ' → Javeo
    Debug.Print parsedData(1)("height") ' → 180
End Sub

VBAの中で「”」を書くときは「””」と2つ重ねる必要があるので、そこだけ少し読みづらいですが、やっていることは「文字列をパースして取り出す」だけです

パースしたJSONから値を取り出す(配列・オブジェクト・ネスト)

ここがVBA-JSONを使ううえで一番つまずきやすく、そして一番大事なところです

ポイントは、パース後のデータが「Dictionary」と「Collection」の2種類に化けているという点です

• JSONの「{ }」(オブジェクト)→ Dictionary になる(キー名で取り出す)
• JSONの「[ ]」(配列)→ Collection になる(番号で取り出す)

この区別さえ分かれば、あとは指定の仕方が決まります、サンプルの「JaveoとJavelinのデータ」を例に、ひとつずつ見ていきましょう

配列(Collection)は番号で取り出す

サンプルのJSONは全体が「[ ]」で囲まれた配列なので、パース直後の parsedData はCollectionになっています

Collectionは「何番目」という番号(インデックス)で要素を取り出します、VBAのCollectionは1番から始まるのがポイントで、0番からじゃないので注意です

' 1人目(Javeo)のデータを取り出す
Set firstPerson = parsedData(1)

' 2人目(Javelin)のデータを取り出す
Set secondPerson = parsedData(2)

オブジェクト(Dictionary)はキー名で取り出す

取り出した1人分のデータ(parsedData(1))は「{ }」のオブジェクトなので、こちらはDictionaryです

Dictionaryは番号ではなく、キー名(項目名)を指定して値を取り出します

' 1人目の名前と身長
Debug.Print parsedData(1)("name")   ' → Javeo
Debug.Print parsedData(1)("height") ' → 180

' 真偽値もそのまま取れる
Debug.Print parsedData(1)("glasses") ' → True

parsedData(1)("name") は「配列の1番目(Collection)→ その中のnameキー(Dictionary)」という読み方になります、カッコが連続するのは、この2段階を一気に書いているからなんですね

ネスト(入れ子)は同じ要領でつなげる

サンプルの birthdate は、中にさらに year / month / day を持つ「入れ子のオブジェクト」です、こういうネストも、考え方は同じでカッコをつなげるだけです

' 1人目の生年月日(birthdateの中のyear)
Debug.Print parsedData(1)("birthdate")("year")  ' → 2000
Debug.Print parsedData(1)("birthdate")("month") ' → 1

' 配列の中の値(favorite_foodsの1個目)
Debug.Print parsedData(1)("favorite_foods")(1) ' → Meat

コツは、「{ }が来たらキー名」「[ ]が来たら番号」をJSONの形に合わせて交互に書いていくだけ、整形したJSONを見ながら指でたどると間違えにくいです

ループでまとめて処理する

実際の業務では「全員分をシートに書き出す」みたいに、繰り返し処理(ループ)で回すことがほとんどです

配列(Collection)は For Each でぐるっと回せます

Sub WriteToSheet()
    Dim parsedData As Object
    Dim person As Object
    Dim i As Long

    Set parsedData = ParseJson(jsonText) ' jsonTextは取得済みとする

    i = 1
    ' 配列の要素(1人分のデータ)を1件ずつ取り出す
    For Each person In parsedData
        Cells(i, 1).Value = person("name")
        Cells(i, 2).Value = person("height")
        Cells(i, 3).Value = person("birthdate")("year")
        i = i + 1
    Next person
End Sub

キー名が分からないオブジェクトを総当たりで見たいときは、.Keys でキー一覧を回す手もあります

Dim key As Variant
' 1人目のオブジェクトのキーと値を全部出す
For Each key In parsedData(1).Keys
    Debug.Print key & " = " & parsedData(1)(key)
Next key

ここまでで「読み込む(パース)」側はバッチリです、配列は番号・オブジェクトはキー名、これさえ押さえれば、たいていのJSONは取り出せます

ConvertToJson でVBAのデータをJSONに変換(生成)

今度は逆方向、つまりVBAのDictionaryやCollectionからJSON文字列を作る(生成する)パターンです、こちらは ConvertToJson 関数を使います

「VBAで作ったデータをAPIに送りたい」「JSON形式でファイルに保存したい」みたいなときに出番があります

Sub CreateJsonString()
    Dim postData As Object
    Dim skillsCollection As Collection
    Dim jsonString As String

    ' データを格納する親オブジェクトを準備
    Set postData = CreateObject("Scripting.Dictionary")

    ' 基本的なキーと値を追加
    postData("name") = "鈴木 一郎"
    postData("age") = 25

    ' 配列用のオブジェクトを「Collection」で準備
    Set skillsCollection = New Collection

    ' Collectionにデータを追加
    skillsCollection.Add "Word"
    skillsCollection.Add "PowerPoint"

    ' 親オブジェクトにCollectionを追加
    postData.Add "skills", skillsCollection

    ' DictionaryをJSON文字列に変換
    jsonString = ConvertToJson(postData)

    ' 結果をイミディエイトウィンドウに出力
    Debug.Print jsonString
    ' 想定される出力: {"name":"鈴木 一郎","age":25,"skills":["Word","PowerPoint"]}

    ' オブジェクトの解放
    Set postData = Nothing
    Set skillsCollection = Nothing
End Sub

ポイントは、JSONの「{ }」はDictionary、「[ ]」はCollectionで組み立てるという点です、パースのときと逆の対応関係になっているだけなので、慣れると自然に書けるようになります

この jsonString をWeb APIに送信(POSTなど)すれば、VBAで作ったデータをサーバーに送れます

改行付きで見やすく出力したいとき

デフォルトのままだと、生成されるJSONは改行なしの一行になります、人が読む用にきれいに整形したいときは、Whitespace オプションを付けます

' インデント2つ分で改行を入れて整形
jsonString = ConvertToJson(postData, Whitespace:=2)

ファイルに保存して中身を確認したいときなんかは、こちらのほうが見やすくておすすめです

VBA-JSONを使わずにJSONを扱う方法(JScript)

ここまでVBA-JSONをおすすめしてきましたが、「ライブラリを追加したくない」「配布先でインポートさせるのが面倒」というケースもありますよね

そういうときの代替案として、Windows標準のJScriptエンジンを使ってJSONをパースする方法もあるので紹介しておきます

JScriptはWindowsに最初から入っているスクリプト実行の仕組みで、これを ScriptControl という部品から呼び出すと、JavaScriptの JSON.parse をVBAから間接的に使えます

Sub ParseByJScript()
    Dim sc As Object
    Dim jsonText As String
    Dim parsed As Object

    jsonText = "{""name"":""Javeo"",""height"":180}"

    ' JScriptエンジンを用意
    Set sc = CreateObject("ScriptControl")
    sc.Language = "JScript"

    ' JavaScriptのJSON.parseで解析
    Set parsed = sc.Eval("(" & jsonText & ")")

    ' プロパティ名で値を取り出す
    Debug.Print parsed.name   ' → Javeo
    Debug.Print parsed.height ' → 180
End Sub

この方法のメリットは、外部ライブラリのインポートが要らないことです

ただ、いくつか弱点もあって、正直なところ常用にはVBA-JSONのほうが向いています

• ScriptControl は32bit版のOfficeでしか動かない(64bit版では別の書き方が必要)
• 取り出した値の扱い(配列やネスト)がVBA-JSONより少しクセがある
• Macでは使えない

なので個人的には、基本はVBA-JSON、どうしてもライブラリを足せない事情があるときだけJScriptという使い分けがおすすめです

VBA-JSONのよくあるつまずき・FAQ

VBA-JSONでハマりやすいポイントを、質問形式でまとめておきます、エラーが出たらまずここを確認してみてください

「ユーザー定義型は定義されていません」と出る

これは 参照設定の漏れがほぼ原因です

VBA-JSONはDictionaryを使うので、WindowsのExcelなら「ツール → 参照設定」で Microsoft Scripting Runtime にチェックが入っているか確認してください、入っていなければチェックを入れて保存し、もう一度実行すれば直ります

MacのExcelの場合は、前述のVBA-Dictionary(Dictionary.cls)を取り込んでいるかを確認しましょう

「KeyNotFoundError」のようなエラーが出る

これは、JSONに存在しないキー名を指定して取り出そうとしたときに出るエラーです

キー名のタイプミス、大文字小文字の違い、そもそもそのキーが無いJSONだった、あたりが定番の原因ですね

このエラーはハマりやすいので、原因の切り分けと対処法を VBA-JSONでKeyNotFoundErrorが発生するときの対処をまとめた記事 で別途くわしく解説しています、同じエラーで止まっている方はそちらをどうぞ

日本語が文字化けする

Web APIから取得したJSONの日本語が文字化けする場合は、文字コードの取り違えが原因のことが多いです

多くのAPIはUTF-8で返してくるので、responseText をそのまま使うとShift_JIS環境で化けることがあります、その場合は responseBody(バイト列)を取得して、UTF-8として読み直すと直ります

Dim stream As Object
Set stream = CreateObject("ADODB.Stream")
stream.Open
stream.Type = 1               ' バイナリ
stream.Write http.responseBody
stream.Position = 0
stream.Type = 2               ' テキスト
stream.Charset = "UTF-8"       ' UTF-8として読み直す
jsonText = stream.ReadText
stream.Close

キーがあるか分からないとき、どう書けばいい？

キーが存在するか不安なときは、取り出す前に .Exists でチェックすると安全です(Dictionaryの機能です)

If parsedData(1).Exists("weight") Then
    Debug.Print parsedData(1)("weight")
Else
    Debug.Print "weightキーはありません"
End If

これを挟んでおくと、キーが無いJSONが来てもエラーで止まらずに処理を続けられます

VBA-JSONの活用例

導入と使い方が分かったところで、「で、実際どんなことに使えるの？」というイメージを少し具体的にしておきます

いちばん多いのは、やはり Web APIのレスポンス(JSON)をパースしてシートに展開するパターンです、為替レート・天気・在庫情報みたいな「外部の最新データ」をExcelに自動で取り込めると、手作業のコピペがまるごと無くなります

たとえばフリマやECのAPIを叩いて、出品データや売上をExcelに集計する、みたいな使い方ですね、APIへリクエストを送る具体的な書き方は eBay APIにVBAでリクエストを送る方法の記事 にまとめているので、JSONパースと組み合わせると一通りの流れがつかめます

逆に ConvertToJson 側だと、VBAで組み立てたデータをJSONにして、メール本文やAPIのリクエストボディに載せる、といった使い方ができます、VBAから自動でメールを送る仕組みは VBAでGmailを送信する方法の記事 で扱っているので、データ生成と通知を組み合わせたい方はあわせてどうぞ

そもそもVBA自体がはじめてで「Dim とか For Each の書き方からあやしい…」という方は、先に VBA入門の記事 で基礎をさらっておくと、この記事のコードもぐっと読みやすくなると思います

AIにVBA-JSONのコードを書いてもらうコツ

最近はClaudeやChatGPTにVBAコードを書いてもらう人も増えてきました、もちろんVBA-JSONを使ったコードも、頼めば書いてくれます

ただ、AIにそのまま「VBAでJSONをパースして」と頼むと、意図しない実装を返してくることがあるんですよね

• VBA-JSONを使わず、自前のJSON解析関数をゼロから書こうとする
• 参照設定の前提がズレていて、そのままだと動かないコードを返す
• 標準機能だけで無理やり読もうとして、やたら長いコードになる

こうしたズレを避けるには、依頼するときに次のような前提を明示するのがおすすめです

VBAで○○のJSONデータをパースするコードを書いてほしい
前提:
- VBA-JSON(JsonConverter.bas)を導入済み
- ParseJson の戻り値を Dictionary / Collection として直接扱う
- 参照設定は Microsoft Scripting Runtime を入れている前提
- 配列は番号、オブジェクトはキー名でアクセスする形で

エラーが出たときも、コードとエラーメッセージをまとめて貼り付ければ、AIが原因と対処をだいたい提示してくれます、自分でハマる時間がかなり減らせるので、これは活用しない手はないです

ClaudeでVBAコードを書いてもらう基本的な流れは Claudeの使い方を初心者向けに解説した記事 にまとめているので、AIにコードを頼むのが初めての方は、そちらから読むとスムーズだと思います

まとめ

VBA-JSONを使えば、これまでVBAでは扱いにくかったJSONが、ぐっと身近になります

導入のポイントはこの2つだけです

• JsonConverter.bas をVBEにインポートする
• Microsoft Scripting Runtime に参照設定する(Macは VBA-Dictionary)

使い方も、覚える関数は2つだけです

• JSONを読み込むなら ParseJson(配列は番号、オブジェクトはキー名で取り出す)
• JSONを書き出すなら ConvertToJson(「{ }」はDictionary、「[ ]」はCollectionで組む)

この導入2ステップと関数2つさえ押さえれば、Web APIとの連携をはじめ、VBAでできることの幅がかなり広がります

まずは手元の短いJSONを ParseJson に通して、Debug.Print で1個取り出してみるところから始めると、感覚がつかみやすいと思います

VBAの独学に効く本PR

Excel VBA塾【動画×本で学ぶ!】

たてばやし淳

Amazonで見る楽天で見る

パーフェクトExcel VBA

高橋宣成

Amazonで見る楽天で見る

Excel マクロ&VBA［実践ビジネス入門講座］完全版 第3版

国本温子

Amazonで見る楽天で見る

私のおすすめからランダムで3冊を表示しています

待機処理が必要な理由

SeleniumでWebサイトを操作するときにありがちな内容がこちら

• ページロードが完了していないうちに要素を取得してエラー
• JavaScriptで動的に生成されるボタンや入力欄がまだ非表示
• ボタンが表示されてもクリック可能になる前に操作しようとしてエラー

これらを解決するには「要素が存在する・表示される・有効になる」まで待機処理が必要です

WebDriverWaitクラスでできること

今回作ったVBAクラス WebDriverWait は、PythonのWebDriverWaitに近い操作性で以下の条件を待機できます

ポイント：

• 成功時は WebElement を返す
• タイムアウト時は Nothing を返す
• Pythonのように例外処理に頼らずVBAらしい安全な設計

VBA版WebDriverWaitの実装例

以下のクラスモジュールをVBAに追加してください※クラス名は WebDriverWait にしています

'--- クラス名: WebDriverWait ---
Option Explicit
'====================================================================================================
' PythonのWebDriverWaitの一部を再現したクラス
' ※条件に合致した場合はWebElementを返して一致しなかった場合はNothingを返す
'   - UntilPresenceeLocated・DOM上に指定したelementが表示されるまで待機は発生し得ないから準備していない
'   - UntilPresence・・・・・DOM上に指定したByが表示されるまで待機
'   - UntilVisibleLocated・・画面上に指定したelementが表示されるまで待機（IsDisplayed）
'   - UntilVisible ・・・・・画面上に指定したByが表示されるまで待機（IsDisplayed）
'   - UntilEnableLocated・・画面上に指定したelementが利用できるまで待機（IsDisplayed & IsEnabled）
'   - UntilEnable ・・・・・画面上に指定したByが利用できるまで待機（IsDisplayed & IsEnabled）
'====================================================================================================
Private pDriver As Selenium.WebDriver
Private pTimeout As Double
Private pInterval As Double

Public Sub Init(driver As Selenium.WebDriver, Optional timeoutSeconds As Double = 10, Optional intervalSeconds As Double = 0.5)
    Set pDriver = driver
    pTimeout = timeoutSeconds
    pInterval = intervalSeconds
End Sub

' Presence
Public Function UntilPresence(By As Selenium.By) As Selenium.WebElement
    Dim start As Double: start = Timer
    Dim elem As Selenium.WebElement
    
    Do
        On Error Resume Next
        Set elem = pDriver.FindElement(By)
        On Error GoTo 0
        
        If Not elem Is Nothing Then
            Set UntilPresence = elem
            Exit Function
        End If
        
        DoEvents
        Application.wait Now + TimeSerial(0, 0, pInterval)
    Loop While Timer - start < pTimeout
    
    Set UntilPresence = Nothing
End Function

' Visibility (By指定)
Public Function UntilVisibleLocated(By As Selenium.By) As Selenium.WebElement
    Dim start As Double: start = Timer
    Dim elem As Selenium.WebElement
    
    Do
        On Error Resume Next
        Set elem = pDriver.FindElement(By)
        On Error GoTo 0
        
        If Not elem Is Nothing Then
            If elem.IsDisplayed Then
                Set UntilVisibleLocated = elem
                Exit Function
            End If
        End If
        
        DoEvents
        Application.wait Now + TimeSerial(0, 0, pInterval)
    Loop While Timer - start < pTimeout
    
    Set UntilVisibleLocated = Nothing
End Function

' Visibility (element指定)
Public Function UntilVisible(elem As Selenium.WebElement) As Selenium.WebElement
    Dim start As Double: start = Timer
    
    Do
        If Not elem Is Nothing Then
            If elem.IsDisplayed Then
                Set UntilVisible = elem
                Exit Function
            End If
        End If
        
        DoEvents
        Application.wait Now + TimeSerial(0, 0, pInterval)
    Loop While Timer - start < pTimeout
    
    Set UntilVisible = Nothing
End Function

' Enable (By指定)
Public Function UntilEnableLocated(By As Selenium.By) As Selenium.WebElement
    Dim start As Double: start = Timer
    Dim elem As Selenium.WebElement
    
    Do
        On Error Resume Next
        Set elem = pDriver.FindElement(By)
        On Error GoTo 0
        
        If Not elem Is Nothing Then
            If elem.IsDisplayed And elem.IsEnabled Then
                Set UntilEnableLocated = elem
                Exit Function
            End If
        End If
        
        DoEvents
        Application.wait Now + TimeSerial(0, 0, pInterval)
    Loop While Timer - start < pTimeout
    
    Set UntilEnableLocated = Nothing
End Function

' Enable (element指定)
Public Function UntilEnable(elem As Selenium.WebElement) As Selenium.WebElement
    Dim start As Double: start = Timer
    
    Do
        If Not elem Is Nothing Then
            If elem.IsDisplayed And elem.IsEnabled Then
                Set UntilEnable = elem
                Exit Function
            End If
        End If
        
        DoEvents
        Application.wait Now + TimeSerial(0, 0, pInterval)
    Loop While Timer - start < pTimeout
    
    Set UntilEnable = Nothing
End Function

使い方サンプル

このブログの練習用ページでテストできるようにしていますので自由にテストしてください

ポイントはInit部分で引数は下記の通りです

wait.Init driver, {最大待機秒数}, {判定間隔}

Sub test()
    Dim driver As New Selenium.ChromeDriver
    Dim By As New Selenium.By
    
    driver.Get "https://javeo.jp/practice_scraping/"

    Dim wait As New WebDriverWait
    wait.Init driver, 10, 0.5

    ' presence_of_element_located(By)
    Dim elemUser As Selenium.WebElement
    Set elemUser = wait.UntilPresence(By.Css("#input_test"))
    

    ' visibility_of_element_located(By)
    Dim elemPass As Selenium.WebElement
    Set elemPass = wait.UntilVisibleLocated(By.Css("#textarea_test"))

    ' element_to_be_clickable(By)
    Dim elemBtn As Selenium.WebElement
    Set elemBtn = wait.UntilClickableLocated(By.Css("[name=""checkbox_test""]"))

    
    elemUser.SendKeys "testuser"
    elemPass.SendKeys "secret"
    elemBtn.Click
End Sub

まとめ

個人的にPythonでもSeleniumを使うのでWebDriverWaitが使えない不便さを感じていました

PythonとVBAでは思想も違うので適当にいじってますが、ほぼ同じように使えてスッキリです！

やっていること

1. chromedriverの保存先は端末環境によって違うので候補となる3箇所のフォルダ有無を確認
2. chromeの保存先も端末環境によって違うので候補となる3箇所のフォルダ有無を確認
3. PowerShellでchromeのバージョンを取得する
   ※なので一瞬PowerShellの画面がチラつきます
4. APIでChrome.exeのビルドまで一致している最新chromedriverのダウンロードパスを取得
5. ダウンロードしたzipファイルを解凍してをseleniumbasic用のフォルダへコピーする

以前作成したVBAはJSON API endpointsを総当たりで取得していたのでJSONをパースする必要がありましたが、APIでドライバのバージョンを直接取得できることに気づいて少し手順を簡略化できました

処理としては数秒しか変わりませんがVBA-JSOＮ不要になったのは個人的にGoodポイント

ここからは以前と同じことを書いてますが単独でこのページを見ていただいた方向けです

必要な参照設定

このプログラムを実行するために設定した参照設定

追加したのは下記3つ

• Microsoft Scripting Runtime
• Microsoft XML, v6.0
• Selenium Type Library

ここは旧バージョンと変わりありません

ファイルへの反映手順

サンプルファイルとソースは下部に準備していますがファイルへの反映方法がわからない方向けに反映と使い方です

そんなことわかってるからはよソースを！って方は下部のソースまで飛んじゃってください

プロパティウィンドウを表示しておく

あとからモジュール名を変更したいので、もし表示されていない時は表示しておく

標準モジュールを追加

自動更新プログラム用にモジュールを追加する

モジュール名を変更する

必須ではないんですが、わかりやすい運用のためにはモジュール名変更推奨です

今回は”ChromeDriverAutoUpdateModule“にします

プログラムの使い方

「<モジュール名>.<プロシージャ名>() ※”<モジュール名>.”は省略可」でプログラムを呼び出せるので、本体プログラムの最初に「ChromeDriverAutoUpdateModule.ChromeDriverAutoUpdate()」を追加すれば必要なときにchromedriverが自動更新されます

Sub main()
'---Chromedriverの自動更新 ※別モジュールを参照
If ChromeDriverAutoUpdateModule.ChromeDriverAutoUpdate Then
    Exit Sub
End If

'－－・－－・－－以下にプログラムを－－・－－・－－
End Sub

Chromedriverの書き込み権限がない時

Winsows11からセキュリティ周りが厳しくなったのか管理者権限でSeleniumBasicをインストールした場合、Chromedriverを更新しようとすると書き込み権限なしエラーが発生するので対応まとめました

画像の通りですが下記手順で権限設定ができます

1. “C:\Program Files”にある”SeleniumBasic”フォルダを右クリック
2. 右クリックメニューで”プロパティ”をクリック
3. セキュリティタブに移って”編集”ボタンをクリック
4. “Users（{コンピュータ名}\Users）”をクリック
5. “フルコントロール”にチェックがついていないはずなのでクリックしてチェックを付ける
6. “適用”ボタンをクリック

サンプルファイル

JSON-VBA含めて最低限のモジュールをセットしたファイル準備したので一から作る時のベースにしていただければ

最後に実際のソース

まずはGithubをご利用の方向けはこちら

https://github.com/javeo2022/webdriver_manager_VBA_Lite

例によってコピペ用はこちらです

Option Explicit
#If VBA7 Then
Private Declare PtrSafe Function URLDownloadToFile Lib "urlmon" Alias "URLDownloadToFileA" _
                        (ByVal pCaller As Long, _
                         ByVal szURL As String, _
                         ByVal szFileName As String, _
                         ByVal dwReserved As Long, _
                         ByVal lpfnCB As Long) As Long
Private Declare PtrSafe Function SHCreateDirectoryEx Lib "shell32.dll" Alias "SHCreateDirectoryExA" _
                        (ByVal hwnd As LongPtr, ByVal pszPath As String, ByVal psa As LongPtr) As Long
#Else
Private Declare Function URLDownloadToFile Lib "urlmon" Alias "URLDownloadToFileA" _
                        (ByVal pCaller As Long, _
                         ByVal szURL As String, _
                         ByVal szFileName As String, _
                         ByVal dwReserved As Long, _
                         ByVal lpfnCB As Long) As Long
Private Declare Function SHCreateDirectoryEx Lib "shell32.dll" Alias "SHCreateDirectoryExA" _
                        (ByVal hwnd As LongPtr, ByVal pszPath As String, ByVal psa As LongPtr) As Long
#End If

Private Type VersionType '---本当はクラスオブジェクトにしたいけどこれだけのためにモジュール作りたくない
    Major As Long
    Minor As Long
    Build As Long
    Revision As Long
    BuildVersion As String
    RevisionVersion As String
End Type
Const ZIP_FILE As String = "chromedriver.zip"
Const DRIVER_EXE As String = "chromedriver.exe"
Dim workPath As String
Sub test()
Call ChromeDriverAutoUpdate
End Sub
Public Function ChromeDriverAutoUpdate(Optional ByVal ForcedExecution As Boolean = False) As Boolean
'====================================================================================================
'chrome.exeとchromedriver.exeのバージョンを比較してchromedriverを自動更新する
'もしくは強制実行フラグ（ForcedExecution）がTrueでも実行する
'====================================================================================================
    Dim chromePath As String '---chrome.exeが保存されているパス
    Dim chromeFullpath As String '---chrome.exeまで含めたフルパス
    Dim chromeVersion As VersionType
    Dim chromedriverPath As String
    Dim chromedriverFullPath As String
    Dim objFso As New Scripting.FileSystemObject
    ' ---chromedriverをダウンロード用のフォルダを作成する　※Seleniumのキャッシュ構造に合わせている
    workPath = Environ("USERPROFILE") & "\.cache\selenium\seleniumbasic"
    Select Case SHCreateDirectoryEx(0&, workPath, 0&)
        Case 0:
            ' ---作成成功
        Case 183
            ' ---作成済み
        Case Else:
            ' ---作成できなかった時
            MsgBox "ダウンロード用フォルダを作成できませんでした" & vbCrLf & Error(Err), vbCritical
            ChromeDriverAutoUpdate = False
            Exit Function
    End Select
    
    '---chrome本体のフォルダを探す
    Select Case True
        Case objFso.FolderExists(Environ("LOCALAPPDATA") & "\Google\Chrome\Application")
            chromePath = Environ("LOCALAPPDATA") & "\Google\Chrome\Application"
        Case objFso.FolderExists(Environ("ProgramW6432") & "\Google\Chrome\Application")
            chromePath = Environ("ProgramW6432") & "\Google\Chrome\Application"
        Case objFso.FolderExists(Environ("ProgramFiles") & "\Google\Chrome\Application")
            chromePath = Environ("ProgramFiles") & "\Google\Chrome\Application"
        Case Else
            MsgBox "'chrome'フォルダが見つかりません", vbCritical
            ChromeDriverAutoUpdate = False
            Exit Function
    End Select
    
    '---念のためchrome.exeを確認する
    If objFso.FileExists(chromePath & "\chrome.exe") = True Then
        chromeFullpath = chromePath & "\chrome.exe"
    Else
        MsgBox "'chrome.exe'が見つかりません", vbCritical
        Exit Function
    End If
    
    '---SeleniumBasicのフォルダを探す
    Select Case True
        Case objFso.FolderExists(Environ("LOCALAPPDATA") & "\SeleniumBasic")
            chromedriverPath = Environ("LOCALAPPDATA") & "\SeleniumBasic"
        Case objFso.FolderExists(Environ("ProgramW6432") & "\SeleniumBasic")
            chromedriverPath = Environ("ProgramW6432") & "\SeleniumBasic"
        Case objFso.FolderExists(Environ("ProgramFiles") & "\SeleniumBasic")
            chromedriverPath = Environ("ProgramFiles") & "\SeleniumBasic"
        Case Else
            MsgBox "'SeleniumBasic'のフォルダが見つかりません", vbCritical
            ChromeDriverAutoUpdate = False
            Exit Function
    End Select
    
    '---念のためchromedriver.exeを確認する
    If objFso.FileExists(chromedriverPath & "\" & DRIVER_EXE) = False Then
        Debug.Print "'chromedriver.exe'が見つかりませんでした"
    End If
    chromedriverFullPath = chromedriverPath & "\" & DRIVER_EXE
        
    '---chrome.exeのバージョンを取得する
    If GetChromeVersion(chromeFullpath, chromeVersion) = False Then '---chrome.exeのバージョンを取得する
        MsgBox "'chrome.exe'のバージョンが取得できませんでした", vbCritical
        ChromeDriverAutoUpdate = False
        Exit Function
    End If
    
    '---chrome.exeのバージョンに合わせたchromedriver.exeをダウンロードする
    If ChromedriverQuickCheck(chromedriverPath, chromeVersion) = False Then '---chromedriverのバージョンを取得する
        MsgBox "'chromedriver.exe'のバージョンが取得できませんでした", vbCritical
        ChromeDriverAutoUpdate = False
        Exit Function
    End If
    
    '---結果として更新していない場合もあるが、更新失敗じゃなくて更新不要な判定だからTrueを返す
    ChromeDriverAutoUpdate = True
Exit Function
ErrLabel:     '---予期せぬエラーの分岐
    MsgBox "chromedriver の入替に失敗しました" & vbCrLf & Error(Err) & vbCrLf & "※この画面のキャプチャを作成者へ送ってください"
    ChromeDriverAutoUpdate = False
End Function
Private Function GetChromeVersion(ByVal chromeFullpath As String, ByRef chromeVersion As VersionType) As Boolean
'====================================================================================================
'PowerShellでchrome.exeのバージョン情報を取得する　※一瞬PowerShellが立ち上がる
'====================================================================================================
    Dim command As String
    Dim objRet As Object
    
    On Error GoTo ErrLabel
        '---chromeバージョン情報の初期値
        chromeVersion.Major = 1
        chromeVersion.Minor = 0
        chromeVersion.Build = 0
        chromeVersion.Revision = 0
        '---chrome.exeのバージョンを取得するPowerShellコマンド
        command = "powershell.exe -NoProfile -ExecutionPolicy Bypass (Get-Item -Path '" & chromeFullpath & "').VersionInfo.FileVersion"
        '---PowerShellの実行結果をセット
        Set objRet = CreateObject("WScript.Shell").Exec(command)
        '---PowerShellのコマンドレットの実行結果を取得
        chromeVersion.RevisionVersion = Trim(objRet.StdOut.ReadAll)
        '---情報の取得が終わったらオブジェクトをクリアする
        Set objRet = Nothing
        '---改行コードが含まれているから削除する
        chromeVersion.RevisionVersion = Trim(Replace(Replace(Replace(chromeVersion.RevisionVersion, vbCrLf, vbNullString), vbCr, vbNullString), vbLf, vbNullString))
        '---バージョン情報を分けて返す
        With CreateObject("VBScript.RegExp") '---正規表現の準備
            .Pattern = "\d+\.\d+\.\d+(\.\d+)?"
            .Global = True
            If .test(chromeVersion.RevisionVersion) Then '---念のため正規表現でバージョン情報をチェックする
                chromeVersion.Major = CLng(Split(chromeVersion.RevisionVersion, ".")(0))
                chromeVersion.Minor = CLng(Split(chromeVersion.RevisionVersion, ".")(1))
                chromeVersion.Build = CLng(Split(chromeVersion.RevisionVersion, ".")(2))
                If UBound(Split(chromeVersion.RevisionVersion, ".")) >= 3 Then '---リビジョン番号がなければ9999を仮でセット※基本あるはず
                    chromeVersion.Revision = CLng(Split(chromeVersion.RevisionVersion, ".")(3))
                Else
                    chromeVersion.Revision = 9999
                End If
                chromeVersion.BuildVersion = Join(Array(chromeVersion.Major, chromeVersion.Minor, chromeVersion.Build), ".") '---リビジョンを覗いたショートバージョン情報をセットする
                Debug.Print "Chromeのバージョン：" & chromeVersion.RevisionVersion
            Else '---正規表現不一致なら失敗で返す
                MsgBox "chrome.exe のバージョン情報取得に失敗しました" & vbCrLf & "[取得バージョン情報：" & chromeVersion.RevisionVersion & "]" & vbCrLf & "※この画面のキャプチャを作成者へ送ってください"
                GetChromeVersion = False
                Exit Function
            End If
        End With
        GetChromeVersion = True
    On Error GoTo 0
    Exit Function
ErrLabel:     '---予期せぬエラーの分岐
    MsgBox "chrome.exe のバージョン情報取得に失敗しました" & vbCrLf & "[" & Error(Err) & "]" & vbCrLf & "※この画面のキャプチャを作成者へ送ってください"
    GetChromeVersion = False
End Function
Private Function ChromedriverQuickCheck(chromedriverPath, chromeVersion As VersionType) As Boolean
    Dim objHttp As New MSXML2.XMLHTTP60
    Dim targetVarsion As String
    Dim uri As String
    Dim api_endpoints As String
    Dim downloadPath As String
    Dim objFso As New Scripting.FileSystemObject
    Const TARGET_PLATFORM As String = "win64"

    api_endpoints = "https://googlechromelabs.github.io/chrome-for-testing/LATEST_RELEASE_" & chromeVersion.BuildVersion
    On Error GoTo ErrLabel
        With objHttp
            .Open "GET", api_endpoints, False
            .Send
            targetVarsion = .responseText '---JSON endpoints から情報を収集する
            downloadPath = workPath & "\" & targetVarsion
            '--- 念のためリビジョンバージョンを比較する
            If chromeVersion.Major >= CLng(Split(targetVarsion, ".")(0)) Then
                '--- まだダウンロードしていなかったらダウンロードする
                If objFso.FileExists(downloadPath & "\" & DRIVER_EXE) = False Then
                    uri = "https://storage.googleapis.com/chrome-for-testing-public/" & targetVarsion & "/" & TARGET_PLATFORM & "/chromedriver-" & TARGET_PLATFORM & ".zip"
                    Call DownloadChromedriver(uri, targetVarsion)
                    Call objFso.DeleteFile(chromedriverPath & "\" & DRIVER_EXE, True)
                    Debug.Print "インストールしたChromedriverのバージョン：" & targetVarsion
                End If
                '--- chromedriverはいつでも上書きする
                Call objFso.GetFile(downloadPath & "\" & DRIVER_EXE).Copy(chromedriverPath & "\" & DRIVER_EXE, True)
            Else
                Debug.Print "Chromeのバージョンが古いためChromedriverは更新しません"
            End If
        End With
    On Error GoTo 0
    ChromedriverQuickCheck = True
    Exit Function
ErrLabel:     '---予期せぬエラーの分岐
    MsgBox "chromedriver.exe の更新に失敗しました" & vbCrLf & "[" & Error(Err) & "]" & vbCrLf & "※この画面のキャプチャを作成者へ送ってください"
    ChromedriverQuickCheck = False
End Function
Private Function DownloadChromedriver(ByVal url As String, targetVersion As String) As Boolean
    Dim rc As Long
    Dim downloadPath As String
    Dim newDriverPath As String
    Dim objFso As New Scripting.FileSystemObject
    Dim objFolder As Scripting.Folder
    downloadPath = workPath & "\" & targetVersion
    ' ---chromedriverのフォルダを作成する
    Select Case SHCreateDirectoryEx(0&, downloadPath, 0&)
        Case 0:
            ' ---作成成功
        Case 183
            ' ---作成済み
        Case Else:
            ' ---作成できなかった時
            MsgBox "ChromeDriver用フォルダを作成できませんでした" & vbCrLf & Error(Err), vbCritical
            DownloadChromedriver = False
            Exit Function
    End Select
    
    '---ファイルをダウンロードする
    If URLDownloadToFile(0, url, workPath & "\" & ZIP_FILE, 0, 0) <> 0 Then
        MsgBox "ChromeDriverをダウンロードできませんでした" & vbCrLf & Error(Err), vbCritical
        DownloadChromedriver = False
        Exit Function
    End If
    Application.DisplayAlerts = False
    '---zipを既定のフォルダに向けて解凍する
    With CreateObject("Shell.Application") '---zipを既定のフォルダに向けて解凍する
        .Namespace((downloadPath)).CopyHere .Namespace((workPath & "\" & ZIP_FILE)).Items
    End With
    '--- 解凍したフォルダから再起処理してchromedriver.exeのフルパスを取得する
    newDriverPath = SearchFilesRecursively(downloadPath & "\", "chromedriver.exe")
    If newDriverPath = "" Then
        MsgBox "chromedriver.exe の更新に失敗しました"
        DownloadChromedriver = False
    End If
    '---chromedriverをバージョンフォルダ直下に移動する
    Call objFso.MoveFile(newDriverPath, downloadPath & "\")
    '---chromedriverがなくなった不要フォルダを削除する
    For Each objFolder In objFso.GetFolder(downloadPath).SubFolders
        objFolder.Delete True
    Next
    '---zipファイルを削除する
    Call objFso.DeleteFile(workPath & "\" & ZIP_FILE, True)
    Application.DisplayAlerts = True
    DownloadChromedriver = True
End Function
Function SearchFilesRecursively(ByVal folderPath As String, fileName As String) As String
    '====================================================================================================
    ' folderPathを起点に再帰処理でサブフォルダまで対象にしてfileNameを探してフルパスを返す
    '====================================================================================================
    Dim objFso As New Scripting.FileSystemObject
    Dim objFolder As Scripting.Folder
    Dim subFolder As Scripting.Folder
    Dim objFile As Scripting.File
    Dim result As String

    ' ファイル一覧をチェック
    For Each objFile In objFso.GetFolder(folderPath).Files
        If objFile.Name = fileName Then
            SearchFilesRecursively = objFile.Path
            Exit Function
        End If
    Next objFile

    ' サブフォルダを再帰的に探索
    For Each subFolder In objFso.GetFolder(folderPath).SubFolders
        result = SearchFilesRecursively(subFolder.Path, fileName)
        If result <> "" Then
            SearchFilesRecursively = result
            Exit Function
        End If
    Next subFolder

    ' 見つからなかった場合
    SearchFilesRecursively = ""
End Function

あとがき

こちらが後出しなので簡易版としましたがむしろこちらを正規版で過去作成した方を特殊版にした方がいいかなと思っているレベル

今後改修するとしたらこちらになる予定です

VBAのループ処理とは？3つの系統で全体像をつかむ

VBAのループ処理とは、ある条件の間や条件を満たすまで、同じ処理を繰り返す仕組みのことです
セルA1からA10までの値を順番に読み取る、リストの中から条件に合うデータだけ抜き出す、といった作業で活躍します

VBAのループ構文はいくつかありますが、ざっくり3系統に分けると全体像がつかみやすいです
まずはこの3つの違いをイメージしてもらえると、この先の話がすっと入ってきます

• For Next … 繰り返す回数が決まっているときの基本形
• For Each … セル範囲やコレクションなど集まりを丸ごと処理する
• Do Loop … 回数が読めず、条件しだいで繰り返したいとき

ジャベ雄

迷ったら「回数が決まってる？」をまず考えるといいですよ

なお、ループのカウンターには変数を使います
変数や型がまだあやふやな方は、先にVBAの変数と定数の解説記事に目を通しておくと、この先がぐっと読みやすくなります

For Next:回数が決まった繰り返し

For Next は、指定した回数だけ繰り返す基本のループです
他の言語でもよく使う形なので、ここを押さえておくと応用が効きます

VBAでは次の形で書きます
※[]の中は省略できる部分です

counter はカウンター役の数値変数で、start が初期値、end が最終値です
古い解説だと To が2回出てくる書き方を見かけますが、それは誤りで、正しくは = start でカウンターに初期値を入れてから To end と続けます

counter は数値が入るので、型は Long や Integer を選びます
下のサンプルは、1から10までの数字をカウンター変数で順番に表示する例です

Dim i As Long
For i = 1 To 10
    Debug.Print i
Next i

もし start が end より大きく、Step が正のままだと、本体の処理は実行されません
条件を満たさないと判断されて、いきなり Next の次へ進む動きになります

Next の後ろのカウンター名(Next i の i)は、省略して Next だけでも動きます
ただ、入れ子のループになると「どの For に対応する Next なのか」が一目で分かりにくくなるので、書いておくと後から読みやすいです

カウンターの型は、扱う回数の大きさで選びます
数万行を超えるような処理では Integer だと上限(32767)を超えてエラーになることがあるので、行数を回すなら Long を選んでおくのがおすすめです

Stepで増減幅を変える(既定は1・負で逆順)

Step を省略するとカウンターは 1ずつ増える 動きになります
Step を付けると増える幅を自由に変えられて、たとえば奇数だけ回したいときは Step 2 を指定すれば、条件分岐を書かなくても1・3・5…と進みます

For i = 1 To 10 Step 2
    Debug.Print i ' ---1，3，5，7，9
Next i

Step にマイナスを指定すると、カウンターを減らしながら回せます
このときは end を start より小さくするのがポイントで、下のサンプルは10から1へ逆順に表示します

Dim i As Long
For i = 10 To 1 Step -1
    Debug.Print i
Next i

逆順はただの小ネタに見えて、実務でしっかり効く場面があります
たとえば行を削除しながら回すとき、上から消すと番号がズレてしまうので、下の行から上へ逆順で回すのが定番のやり方です

最終行まで処理する(実務で一番使う形)

実務でいちばん多いのは「データが入っている最終行まで回したい」というケースです
このときは Cells(Rows.Count, 1).End(xlUp).Row でA列の最終行を取り、その行数まで For Next で回します

Dim lastRow As Long
lastRow = Cells(Rows.Count, 1).End(xlUp).Row

Dim i As Long
For i = 1 To lastRow
    Debug.Print Cells(i, 1).Value
Next i

データの行数は日々変わるので、固定の数字で回すと取りこぼしや空行の処理が起きやすいです
最終行を毎回求めてから回す形にしておくと、行が増えても減ってもそのまま動いてくれます

ここで使っている Cells(Rows.Count, 1) は、シートのいちばん下のセルを指しています
そこから End(xlUp) で上へジャンプすると、データが入っている最後の行に止まるので、その行番号を最終行として使う、という流れです

列の番号(ここでは1=A列)は、いちばんデータが詰まっている列を選ぶのがコツです
途中に空白セルが混ざる列を基準にすると、そこで止まって最終行を取りこぼすことがあるので注意します

二重ループで表(行×列)を処理する

表のように行と列の両方を回したいときは、For Next を入れ子(二重ループ)にします
外側で行を回し、その中でさらに内側のループで列を回す、という組み立てです

Dim r As Long, c As Long
For r = 1 To 3
    For c = 1 To 3
        Debug.Print Cells(r, c).Value
    Next c
Next r

入れ子にすると、後で出てくる Exit の挙動に少し注意が必要になります
内側のループで抜けても、抜けるのはその1段だけ、という点は途中抜けのところで改めて触れます

このサンプルは3行×3列の決め打ちですが、実務では行も列も最終位置を求めて回すことが多いです
外側を最終行まで、内側を最終列まで回すようにすると、表の大きさが変わっても同じコードでそのまま処理できます

ジャベ雄

内側と外側でカウンター変数を別にするのを忘れずに

For Each Next:コレクション・配列をまるごと処理

For Each Next は、複数の要素を持つコレクションや配列を、丸ごと順番に処理するループです
構文は For Each element In group … 処理 … Next [element] という形になります

ループ変数の element は、相手によって向いている型が変わります
セル範囲のようなコレクションが相手ならオブジェクト型(またはVariant)、配列が相手なら Variant を使うのがVBAでのお作法です

For Each の良さは、要素数を自分で数えなくていいところです
対象の数が不定でも「中身ぜんぶ」を相手にしてくれるので、コレクションを扱うときに特に書きやすくなります

For Next との違いは、何番目かを表すカウンターを自分で持たない点です
「3番目だけ処理したい」のように位置で指定したいなら For Next、「中身を順番に全部」でよいなら For Each、と分けて考えると選びやすくなります

セル範囲を1つずつ処理する

まずは定番、セル範囲を1つずつ取り出す例です
下のサンプルは、A1からA10までのセルの値を順番に表示します

Dim cell As Range
For Each cell In Range("A1:A10")
    Debug.Print cell.Value
Next cell

配列を回す(For Nextでも代替できる)

配列が相手なら、For Each でも For Next でも回せます
For Next を使うときは、LBound と UBound でインデックスの最小値と最大値を取り、その範囲を順番に指定します

下の2つは、どちらも同じ結果になります

Dim sample As Variant
Dim v As Variant

sample = Array("a", "b", "c", "d", "e")
For Each v In sample
    Debug.Print v
Next

Dim i As Long
For i = LBound(sample) To UBound(sample)
    Debug.Print sample(i)
Next

配列の要素数は UBound – LBound + 1 で求められます
LBound が0始まりなのか1始まりなのかを気にせず数えられるので、覚えておくと地味に便利です

ブック内のシートを全部処理する

For Each がいちばん書きやすさを発揮するのが、シートのような「集まり」を相手にするときです
ブックに何枚シートがあるか数えなくても、Worksheets をそのまま渡せば全シートを順番に処理できます

Dim ws As Worksheet
For Each ws In ThisWorkbook.Worksheets
    Debug.Print ws.Name
Next ws

シートの枚数は追加・削除でよく変わるので、枚数を数字で決め打ちするとズレやすいです
For Each なら「いまブックにある分ぜんぶ」を相手にしてくれるので、枚数が変わってもそのまま動きます

同じ書き方で Workbooks を渡せば、開いているブックを順番に処理することもできます
「シートを左から順に」「開いているブックを全部」のような作業は、For Each の出番だと覚えておくと選びやすいです

辞書(Dictionary)やコレクションを回す

キーと値をペアで持てる Dictionary や、要素を順に足していける Collection も、For Each で回せます
件数が決まっていない集計やリスト管理で使うと、要素数を気にせず中身を取り出せて楽です

Dim dic As Object
Set dic = CreateObject("Scripting.Dictionary")
dic.Add "apple", 100
dic.Add "banana", 200

Dim k As Variant
For Each k In dic.Keys
    Debug.Print k & " : " & dic(k)
Next k

Dictionary の場合は Keys を回して、キーから値を取り出すのが定番の形です
受け取る変数の型は、相手が文字列でも数値でも対応できる Variant にしておくと無難です

Do Loop:条件しだいで繰り返す

Do Loop は、条件に応じて繰り返すループです
終了条件を柔軟に決められるので、回数が読めない処理に向いていて、骨組みは Do … 処理 … Loop だけとシンプルです

シンプルなぶん、条件の付け方で動きが変わります
ここでは While・Until・前判定と後判定の違いを、順番に見ていきます

For Next と Do Loop の使い分けは、回数が先に決まるかどうかで考えると分かりやすいです
「10回」「最終行まで」のように回数や終わりが先に分かるなら For Next、「条件を満たすまで」「データが続く限り」のように終わりが読めないなら Do Loop が向いています

Do While(条件が真の間)

While は「条件が真の間、繰り返す」という意味です
Do Loop の中ではいちばんよく使う形で、体感では大半がこの書き方になります

Dim i As Integer
i = 1
Do While i <= 10
    Debug.Print i
    i = i + 1
Loop

ここで大事なのが、ループの中でカウンターを i = i + 1 と変化させている点です
これを忘れると条件がいつまでも真のままになり、後で触れる無限ループの原因になります

Do Until(条件が真になるまで)

Until は「条件が真になるまで繰り返す」という意味で、While とは逆向きの考え方です
「この状態になったら終わり」という書き方をしたいときに合います

Dim i As Integer
i = 1
Do Until i > 10
    Debug.Print i
    i = i + 1
Loop

While と Until は、慣れるまで頭の中で逆に取りやすいところです
同じ動きを While でも Until でも書けることが多いので、自分が読みやすいと感じる方に寄せておくと迷いません

前判定と後判定(Doの後ろ・Loopの後ろ)

While・Until は、Do の後ろにも Loop の後ろにも書けます
Do の後ろに書くのが前判定、Loop の後ろに書くのが後判定で、両方ちゃんと動きます

Do While i <= 10
    ' 処理
Loop

Do
    ' 処理
Loop While i <= 10

大きな違いは、後判定だと 条件に関係なく最低1回は処理が実行される 点です
前判定は入る前に条件を見るので0回もありえますが、後判定は中身を1回やってから判定します

While Wend(古い書き方)

While Wend という古い構文もあって、これは Do While Loop と同じ前判定ループの動きをします
誰かが書いた古いコードで見かけることがあるので、読めるようにしておくと十分です

Dim i As Integer
i = 1
While i <= 10
    Debug.Print i
    i = i + 1
Wend

動き自体は Do While Loop と同じ前判定なので、新しく書くなら Do Loop の方が一般的です
あえて While Wend を選ぶ理由は少ないので、読み解き用の知識として持っておけば問題ありません

空セルになるまで下へ回す(実務例)

Do Loop が実務で活きるのは「どこまでデータがあるか分からない」ケースです
最終行を先に求めなくても、セルが空になるまで下へ進む という書き方で、データの終わりまで回せます

Dim i As Long
i = 1
Do While Cells(i, 1).Value <> ""
    Debug.Print Cells(i, 1).Value
    i = i + 1
Loop

For Next で最終行まで回す形と似ていますが、こちらは行数を先に計算しないのが違いです
データの途中に空行が混ざらない前提なら、書き方がシンプルで読みやすくなります

Withと組み合わせて書きやすくする

同じオブジェクトを何度も書く場面では、With と組み合わせると見通しがよくなります
ループの中で同じシートやセル範囲を繰り返し指すとき、毎回フルで書かずに済むので、コードがすっきりします

Dim i As Long
With ThisWorkbook.Worksheets("Sheet1")
    For i = 1 To 10
        .Cells(i, 1).Value = i
    Next i
End With

With の中では、先頭にドットを付けるだけで対象のオブジェクトを指せます
シート名を何度も書く手間が減り、後から対象を変えたいときも一か所の修正で済むのが利点です

VBAの独学に効く本PR

Excel VBA塾【動画×本で学ぶ!】

たてばやし淳

Amazonで見る楽天で見る

パーフェクトExcel VBA

高橋宣成

Amazonで見る楽天で見る

Excel マクロ&VBA［実践ビジネス入門講座］完全版 第3版

国本温子

Amazonで見る楽天で見る

私のおすすめからランダムで3冊を表示しています

ループを途中で抜ける・スキップする(Exit / Continue代替)

条件しだいでループを途中でやめたいときは Exit For や Exit Do を使います
他の言語の break にあたる役割で、If や Select Case の中に書いて「ここで抜ける」を表現します

下のコードは1〜4まで表示して、iが5になったところでループを抜けます

For i = 1 To 10
    If i = 5 Then Exit For
    Debug.Print i
Next i

Do Loop でも考え方は同じで、Exit Do を使えば途中で抜けられます
While や Until を付けない Do … Loop でも、中で条件を見て Exit Do すれば終了できます

Do
    If 条件 Then Exit Do
    ' 処理
Loop

他の言語にある continue(その回だけスキップして次へ進む)は、VBAにはありません
似た動きは GoTo とラベルで作れて、下のコードは i が5のときだけ表示をスキップします

For i = 1 To 10
    If i = 5 Then GoTo Skip
    Debug.Print i
Skip:
Next i

GoTo は便利に見えますが、増えると処理の流れが追いにくくなってデバッグが大変になります
使うとしても最小限にとどめ、できれば If でくくる形に書き換える方が後で読みやすいです

目的のデータが見つかったら抜ける(検索パターン)

Exit がいちばん役立つのは、リストを上から見ていって「探していたものが見つかったら終わり」にしたいときです
全部回さずに見つかった時点で抜けられるので、データが多いほど処理の無駄を減らせます

Dim i As Long, foundRow As Long
foundRow = 0
For i = 1 To 1000
    If Cells(i, 1).Value = "target" Then
        foundRow = i
        Exit For
    End If
Next i

Debug.Print foundRow

見つかった行を変数に控えてから Exit For で抜けると、ループの後でその行を使えます
もし最後まで見つからなければ、初期値の0のままなので「無かった」判定にも使えて便利です

無限ループの止め方と防ぎ方

ループを書いていていちばん怖いのが無限ループです
終了条件にたどり着かず、いつまでも処理が終わらない状態で、画面が固まったように見えてヒヤッとします

起きる原因はだいたい決まっていて、条件が変わらないことと、カウンターの更新忘れです
Do While の中で i = i + 1 を書き忘れる、というのが定番のパターンになります

もうひとつ多いのが、終了条件が一生満たされないケースです
たとえば「空セルになるまで」と書いたのに、途中の空行を飛ばす処理を入れてしまうと、終わりにたどり着けず回り続けることがあります

VBAの編集画面で Ctrl + Break を押すと処理が止まり、いま実行している行が黄色く反転して教えてくれます
その行のまわりを見れば、どの条件が変わっていないのか・カウンターの更新が抜けていないかを確かめやすくなります

止め方を知っていれば怖くないですが、そもそも起こさないのがいちばんです
無限ループを防ぐコツは、次の3つを意識しておくと大きく減らせます

• ループの中で、条件に関わる値を毎回更新する
• Do内のカウンター更新(i = i + 1 など)を忘れない
• 保険として、一定回数を超えたら Exit Do で抜ける仕掛けを入れておく

ジャベ雄

固まっても焦らず Esc を押せば戻ってこれますよ

ループを速くする2つのコツ

扱う行数が増えてくると、ループの遅さが気になってきます
処理が重いと感じたときに効きやすい、定番の2つのコツを紹介します

コツ1:配列に一括で読み込んで処理する

セルを1つずつ読み書きすると、そのたびにExcelとのやり取りが発生して時間がかかります
そこで、セル範囲をいったん配列にまとめて読み込み、ループで処理してから一括で書き戻すと、ぐっと速くなることが多いです

Dim data As Variant
data = Range("A1:A10000").Value   ' セル範囲を一括で配列に読み込む

Dim i As Long
For i = 1 To UBound(data, 1)
    data(i, 1) = data(i, 1) * 2
Next i

Range("A1:A10000").Value = data   ' 配列を一括で書き戻す

複数セルのRangeをValueで受け取ると、中身は2次元配列になります
だから添字は data(行, 列) の形になり、A列1列でも data(i, 1) のように列番号の1が要ります

なぜ速くなるかというと、セルへのアクセスは1回ごとにExcel側とのやり取りが走るからです
1万行を1つずつ読み書きすると、そのやり取りが1万回起きてしまいますが、配列なら読み込みと書き戻しの2回で済むので、処理時間に差が出ます

行数が数百くらいなら体感差は小さいですが、数千・数万と増えるほど効いてきます
「ループが重いな」と感じたら、まずこの配列一括の形に書き換えられないか考えてみると改善しやすいです

コツ2:画面更新をオフにする

重いループの間、Excelが画面をいちいち描き直すのも遅さの一因です
Application.ScreenUpdating = False で更新を止めてからループを回すと、見た目のちらつきも処理時間も抑えられます

Application.ScreenUpdating = False

' ここで重い繰り返し処理を実行

Application.ScreenUpdating = True

ここで大事なのが、処理が終わったら忘れず = True に戻すことです
戻し忘れると画面が固まったように見えてしまうので、オフにしたらセットで戻す、とペアで覚えておきましょう

同じ発想で、自動計算を Application.Calculation = xlCalculationManual で一時的に止める手もあります
関数が多く入ったシートだと、書き込むたびに再計算が走って重くなるので、ループの間だけ止めると効きます
これも処理後に xlCalculationAutomatic へ戻すのを忘れないようにします

まとめ:構文の使い分け早見表

最後に、ここまでの内容を早見表にまとめます
判断の目安はシンプルで、回数が決まるなら For Next、集まりを全部なら For Each、条件しだいなら Do Loop、まず1回やりたいなら後判定です

ループはVBAの基礎ですが、ここを押さえると書けるマクロの幅が一気に広がります
まずは For Next と Do While あたりから手を動かして、必要になったら For Each や高速化のコツを足していくのがおすすめです

ループと組み合わせると便利なテーマとして、データを扱う型まわりの知識があります
変数や型をもう一段固めたい方はVBAの変数と定数の解説記事、JSONのようなデータ処理に進みたい方はVBAでJSONを扱う記事もあわせてどうぞ

VBAの独学に効く本PR

Excel VBA塾【動画×本で学ぶ!】

たてばやし淳

Amazonで見る楽天で見る

パーフェクトExcel VBA

高橋宣成

Amazonで見る楽天で見る

Excel マクロ&VBA［実践ビジネス入門講座］完全版 第3版

国本温子

Amazonで見る楽天で見る

私のおすすめからランダムで3冊を表示しています

そもそもVBAの変数とは？基礎から押さえる

結論から言うと、変数は中身を入れ替えられる箱です
数値や文字を一度しまっておいて、あとから取り出したり書き換えたりできます

変数とは「中身が変わる箱」

イメージとしては、Excelのセルが近いです
セルA1に数値を入れて、あとで別の数値で上書きできるのと同じで、変数も値を入れたり入れ替えたりできる入れ物だと思ってください

たとえば合計金額を計算するなら、計算結果をいったん変数にしまっておいて、あとで表示したりセルに書き戻したりします
セルに直接書き込み続けるより、いったん変数を経由したほうがコードが追いやすくなります

ジャベ雄

最初は「ラベルを貼った箱」くらいの感覚でOKです

変数を使う3つのメリット

なぜわざわざ変数を使うのか、メリットは大きく3つあります

• 処理効率が上がる … 一度計算した値を使い回せるので、同じ計算を何度も書かずに済みます
• 保守しやすい … 値を1か所にまとめておけば、後から直すときもその変数だけ見ればよくなります
• 読みやすい … targetRow のように意味のある名前を付けると、コードが何をしているか一目で伝わります

とくに最後の「読みやすさ」は、あとからじわじわ効いてきます
セルの座標を数字で直書きすると後から見て意味が分からなくなりますが、名前のある変数なら自分にもチームにもやさしいコードになります

変数の書き方(Dimで宣言する)

変数を使う前に「これから使いますよ」と宣言します
基本の形は Dim 変数名 As データ型 です

Dim score As Integer
Dim name As String

Dim は「宣言する」を意味するキーワード、その後ろに自分で決めた変数名、As の後ろにデータ型を書きます
上の例だと、score という整数の箱と、name という文字の箱を用意した、と読めます

データ型は「この箱には何を入れるか」を決める指定です
整数なら Integer、文字なら String といった具合で、種類は後ほどまとめて紹介します

Option Explicitで宣言を強制する

ここが入門者にとって一番の押しどころです
モジュールの先頭に Option Explicit と書いておくと、宣言していない変数を使った瞬間にエラーで教えてくれます

何がうれしいかというと、変数名のタイプミスをコンパイル時に弾いてくれるところです
たとえば targetRow と書くつもりが targetRwo と打ち間違えても、Option Explicit があれば「そんな変数は宣言されてないよ」と止めてくれます

これが無いと、打ち間違えた名前が新しい空っぽの変数として勝手に作られてしまいます
計算が合わないのに原因が分からない、やっかいなバグの温床です

ジャベ雄

私はこれを入れてから、typoバグでハマる回数がぐっと減りました

変数の命名規則(VBA公式ルールと慣習)

変数名は自由に付けられますが、いくつか守るべきルールと、守ると読みやすくなる慣習があります
ここを分けて理解しておくと、名付けで迷いにくくなります

公式の命名ルール

まず、VBAの仕様として決まっている制約はこちらです

• 先頭は文字(アルファベットや日本語)で始める、数字や記号からは始められません
• スペースや一部の記号(.(ピリオド)! @ & $ #)は使えません
• 長さは255文字以内に収めます
• VBAの関数名やステートメント名と同じ名前(予約語)は避けます
  衝突するので別の名前にします

予約語については「使えない」より「避ける」が正確です
たとえば Date のような語と同じ名前を付けると意味が衝突するので、別の名前にしておくのが無難です

よく使う命名スタイル

次は慣習の話です
変数名の付け方にはいくつか流派があって、どれもルールではなく読みやすさのための慣習です

Dim targetRow As Long   ' ---キャメルケース
Dim lngRow As Long      ' ---ハンガリアン記法
Dim target_row As Long  ' ---スネークケース 
Dim TargetRow As Long   ' ---パスカルケース
Dim 対象行 As Long       ' ---日本語は非推奨

• キャメルケース … 2語目以降の頭を大文字に(targetRow)、読みやすく人気のスタイル
• ハンガリアン記法 … 型を示す接頭辞を付ける(lngRow なら Long)、ひと目で型が分かります
• スネークケース … 単語をアンダースコアでつなぐ(target_row)
• パスカルケース … すべての単語の頭を大文字に(TargetRow)
• 日本語 … 動きはしますが文字化けや入力切替の手間があり非推奨です

大事なのは、どれが正解かではなく1つのプロジェクトで統一する点です
キャメルケースとハンガリアン記法が混ざっていると逆に読みにくくなるので、自分なりのルールを決めて揃えると安心です

ジャベ雄

こんなのもあるんだー、くらいでまずは大丈夫です

変数のスコープ(適用範囲)を理解する

スコープとは、その変数がどこまで使えるかという範囲のことです
結論を先に言うと、宣言する場所によって「使える範囲」が変わります

宣言する場所による違い

変数を宣言する場所はざっくり2か所あります
プロシージャ(Sub や Function)の中で宣言するか、モジュールの先頭(どのプロシージャよりも前)で宣言するかです

プロシージャの中で Dim したローカル変数は、そのプロシージャを抜けると消えます
逆にモジュールの先頭で宣言すると、そのモジュールの複数のプロシージャから同じ変数を共有できます

PrivateとPublicステートメント

モジュールの先頭で宣言するとき、Private と Public で公開範囲を変えられます
違いは、他のモジュールから触れるかどうかです

ちなみに、モジュールの先頭で Dim をそのまま使うと、これは Private と同じ扱いになります
つまり同じモジュール内からは使えるけれど、他のモジュールからは触れません

もう1つ覚えておくと便利なのが Static です
プロシージャ内で Static を使って宣言すると、プロシージャを抜けても値が残ります
呼び出すたびに1ずつ増えるカウンターを作りたいときに使えます

ジャベ雄

まずは「Dim=その場だけ」「Public=全体で共有」を押さえればOKです

VBAの独学に効く本PR

Excel VBA塾【動画×本で学ぶ!】

たてばやし淳

Amazonで見る楽天で見る

パーフェクトExcel VBA

高橋宣成

Amazonで見る楽天で見る

Excel マクロ&VBA［実践ビジネス入門講座］完全版 第3版

国本温子

Amazonで見る楽天で見る

私のおすすめからランダムで3冊を表示しています

VBAのデータ型一覧と選び方

データ型は「この箱に何を入れるか」を決める指定です
適切な型を選ぶと、メモリの無駄が減り、想定外の値が入るのを防げます

基本的なデータ型

まずは入門でよく使う型をまとめました
全部覚える必要はなく、最初は Long(整数)String(文字)Double(小数)あたりを押さえれば十分です

お金の計算をするなら Currency が向いています
小数点以下4桁で固定されるので、Double で起きがちな小さな誤差が出にくく、金額の足し引きに強いです

Boolean と Date の初期値には「※」を添えています
これは公式に「初期値はこれ」と名指しされているわけではなく、挙動上 Boolean は False、Date はシリアル値0として扱われる、という意味の注記です

オブジェクト型とSet

セルやワークブックそのものを変数に入れたいときは、オブジェクト型を使います
このとき普通の = ではなく Set から始めるのがポイントです

Dim name As String
Dim wb As Workbook

name = "ジャベ雄"
Set wb = Thisworkbook ' ---オブジェクトへの代入はSetから始める

文字や数値はそのまま = で代入できますが、ワークブックやワークシートのようなオブジェクトは Set を付けないと代入できません
うっかり Set を忘れるとエラーになるので、オブジェクトには Set とセットで覚えておくと安心です

なお、オブジェクト型の変数はまだ何も入れていない状態だと Nothing(どのオブジェクトも参照していない)になります
Set で実際のオブジェクトを代入してはじめて使えるようになります

万能型のVariantとObject

Variant は何でも入る万能型です
データ型を指定しない(As を省略する)と、原則この Variant が割り当てられます

便利そうに見えますが、Variant は基本的に避けたい型です
型が決まっていないぶん想定外の値が入りやすく、typo にも気づきにくくなります
配列を柔軟に扱いたいときなど、必要な場面に絞って使うのがおすすめです

列挙型(Enum)とユーザー定義型(Type)

少し発展的な型として、Enum と Type も紹介しておきます
こんなのもあるんだー、ぐらいで読み飛ばしてもらって大丈夫です

まず Enum(列挙型)は、関連する数値に名前を付けてまとめられる型です
曜日や区分のように、決まった選択肢を分かりやすく扱いたいときに便利です

Enum WeekDay
    Sunday      ' 0
    Monday      ' 1
    Tuesday     ' 2
    Wednesday   ' 3
    Thursday    ' 4
    Friday      ' 5
    Saturday    ' 6
End Enum

Sub ShowDay()
    MsgBox "今日の曜日は: " & WeekDay.Monday  ' 結果は「1」
End Sub

次に Type(ユーザー定義型)は、複数のデータを1つにまとめた自作の型です
下の例だと、名前・年齢・給与をひとかたまりの「従業員」として扱えます

Type Employee
    Name As String
    Age As Integer
    Salary As Double
End Type

Sub ShowEmployee()
    Dim emp As Employee
    emp.Name = "田中 太郎"
    emp.Age = 30
    emp.Salary = 5000000

    MsgBox "氏名: " & emp.Name & vbCrLf & _
           "年齢: " & emp.Age & vbCrLf & _
           "給与: " & emp.Salary & "円"
End Sub

このあたりは慣れてきてから使えば十分です
最初は基本のデータ型を使いこなすところを優先しましょう

定数(Const)の使い方

定数は、一度決めたら中身が変わらない箱です
変数が「入れ替えられる箱」なのに対して、定数は「最初に決めた値で固定する箱」だと考えてください

定数とは(変わらない値)

たとえば消費税率や、決まった上限値のように、プログラムの途中で変わってほしくない値を入れるのに向いています
定数は宣言時に値を確定させ、その後は書き換えられません

定数を使うメリット

• 安全 … 実行中にうっかり書き換わる心配がありません
• 一括変更できる … 値を1か所にまとめておけば、変更があってもそこだけ直せば済みます
• 読みやすい … 0.1 のような数字を直書きするより、TAX_RATE のような名前のほうが意味が伝わります

ここで大事になるのがマジックナンバーの回避です
0.1 や 100 のようにコードへ直接書かれた意味の分かりにくい数字をマジックナンバーと呼びますが、TAX_RATE のような定数に置き換えると、名前そのものが値の説明になってくれます

ジャベ雄

「あちこちに同じ数字を直書きしてた…」が無くなるのは大きいです

定数の書き方

定数の宣言は Const 名 As 型 = 値 の形です
変数の Dim と違い、宣言と同時に値まで決めてしまうのが特徴です

Const score As Integer = 100
Const name As String = "ジャベ雄"

定数の式には、ほかの定数やリテラル(直接書いた数値や文字)、四則演算は使えますが、変数や関数は使えません
あくまで「最初に確定できる値」だけを入れる、と覚えておくと迷いません

定数にもスコープがあります
モジュールの先頭で宣言して Public を付ければ他のモジュールから使えますが、プロシージャの中で書いた定数はそのプロシージャの中だけで、公開範囲は変えられません

定数の命名規則

定数は変数と区別しやすいよう、すべて大文字+アンダースコアで書く慣習があります
これも仕様ではなく慣習ですが、コードの中で「ここは固定値だな」と一目で分かるので便利です

Const MAX_USER_COUNT As Integer = 100
Const DEFAULT_FONT_SIZE As Double = 12.5
Const API_ENDPOINT_URL As String = "https://example.com/api"

このように大文字で書いておくと、後からコードを読んだときに変数と定数がすぐ見分けられます
小さな工夫ですが、保守のしやすさにつながります

変数・定数のよくある質問(FAQ)

最後に、初心者の方からよく出る疑問をまとめました
つまずきやすいポイントなので、気になるところだけでも目を通してみてください

まとめ

VBAの変数と定数を一通り見てきました
最後に押さえておきたいポイントを振り返ります

• 変数は中身が変わる箱、定数は中身を固定する箱
• 宣言は Dim 変数名 As データ型、型を指定すると無駄やミスが減る
• モジュール先頭に Option Explicit を入れて宣言を強制し、typo を防ぐ
• スコープ(使える範囲)は宣言する場所で決まる

変数の代表的な使いどころのひとつが、ループのカウンター変数です
繰り返し処理で「今が何回目か」を数えるのに変数を使うので、変数になじんだらVBAのループ処理もあわせて読むと、コードの幅がぐっと広がります

ジャベ雄

まずは Dim と型、Option Explicit から始めてみてくださいね

VBAの独学に効く本PR

Excel VBA塾【動画×本で学ぶ!】

たてばやし淳

Amazonで見る楽天で見る

パーフェクトExcel VBA

高橋宣成

Amazonで見る楽天で見る

Excel マクロ&VBA［実践ビジネス入門講座］完全版 第3版

国本温子

Amazonで見る楽天で見る

私のおすすめからランダムで3冊を表示しています

VBAを始める前に

VBAを始める前にまずVBAの概要とExcelの準備です

VBAとは

VBA（Visual Basic for Applications）は、Microsoft 365・Office製品（Excel、Accessなど）で使用できるプログラミング言語です

よくVBAとマクロの違いみたいな話を見ますがマクロは機能名でVBAはその中身って感じで会話の中では同じものとして扱って大丈夫かなと

VBAを使いこなせば、これまで何時間もかかっていた作業がボタン一つで一瞬で終わる、なんてことも夢ではありません

開発者タブを表示しよう

ExcelでVBA始めるならまず開発タブを表示しましょう

正直慣れるとVBEの画面は”Alt+F11“で開くしマクロは”Alt+F8“で実行しちゃうので使う頻度は減りますが最初はあったほうが便利です

VBAで押さえておきたい基本

VBAを学ぶ上で、最低限知っておきたい基本的な概念をいくつか紹介します

最初は難しく感じるかもしれませんが、深堀は別でやりますので今は「こういうものがあるんだな」くらいの気持ちで読み進めてください

変数と定数

プログラミングでは、データ（数値や文字列など）を一時的に保存しておくための「箱」のようなものを使いますが、この箱のことを変数や定数と呼びます

Sub test()
Const tax_rate As Double = 0.1 '---税率
Dim price_excluding_tax As Long '---税抜き価格
Dim price_including_tax As Long '---税込み価格

price_excluding_tax = 1980
price_including_tax = price_excluding_tax * (1 + tax_rate)
Debug.Print (price_including_tax)
End Sub

データ型

変数や定数には、どんな種類のデータを入れるかをあらかじめ決めておく必要があり、これをデータ型と呼びます

例えば、数値を扱うのか、文字を扱うのか、日付を扱うのか、といった区別です

条件分岐、ループ処理などのフロー制御

プログラムは基本的に上から下へ順番に実行されますが、フロー制御を使うことで状況に応じて処理の流れを変えることができます

' A1～A10のセルの中で300以上の数字だったら文字を赤くする
Sub test()
Dim i As Long
For i = 1 To 10
    If Cells(i, 1).Value >= 300 Then
        Cells(i, 1).Font.Color = RGB(255, 0, 0)
    End If
Next
End Sub

メインプロシージャとサブプロシージャ

VBAでは、一連の処理のまとまりをプロシージャと呼びます

機能や仕組みではなく、役割や考え方みたいな位置づけなので必ずしもこの二つが必要ってわけではなく簡単なプログラムならプロシージャー1つなんてことも多々ありますし、サブプロシージャーのさらにサブプロシージャーを作ったりすることもあります

車でいうとメインプロシージャが車の組み立て、サブプロシージャーが各部品の作成のイメージですね

Sub MainProcedure()
    Debug.Print ("これがメインプロシージャーです")
    Call SubProcedure1
    Call SubProcedure2
End Sub
Sub SubProcedure1()
    Debug.Print ("これがメインプロシージャー1です")
End Sub
Sub SubProcedure2()
    Debug.Print ("これがメインプロシージャー2です")
End Sub

可読性の重要性

VBAは自分だけでなく、他の人がコードを読む（または将来の自分が見返す）可能性もあります

誰が見ても分かりやすい、可読性の高いコードを書くことは非常に重要です

インデントについて

インデントとは、行頭の字下げのことで処理の塊（ブロック）を視覚的に分かりやすくするために行います

If文やFor文などフロー制御の中の処理は、インデントを下げるのが一般的です

' 悪い例
If Range("A1").Value > 10 Then
MsgBox "10より大きいです"
End If

' 良い例
If Range("A1").Value > 10 Then
    MsgBox "10より大きいです"
End If

変数などの命名規則について

変数やプロシージャの名前は、その役割がひと目で分かるように付けることが大切です

例えば、”a"や”b"のような無意味な名前ではなく、"userName"（ユーザー名）や"calculateTotalPrice"（合計金額を計算する）のように一見して意味が分かるようにすることが望ましいです

書き方にも規則性がありまして”定数は全て大文字にする”、”プレフィックスでデータ型を示す”、”単語を特定の文字で繋ぐ”などなど言語や時代によって変化はありますが少なくとも一つのプログラムの中では一貫したルールにすべきです

モジュールの種類

VBAのコードを記述する場所をモジュールと呼びます

モジュールにはいくつか種類がありますが、初心者がまず覚えておくべきなのは以下の2つです

まとめ

今回は、VBAの魅力とその基本的な概念についてお話ししました。最初は覚えることが多くて大変に感じるかもしれませんが、一つ一つは決して難しいものではありません。

VBAを学ぶ最大のメリットは、日々の業務に直結するスキルであるということです。学習したことがすぐに実践で活かせ、成果が目に見えやすいので、モチベーションを維持しやすいのも特徴です。

このブログでは、今後もVBAの具体的な書き方や便利なテクニックをどんどん紹介していきます。ぜひ、次回の記事もチェックして、退屈な繰り返し作業から解放され、より創造的な仕事に時間を使えるようになりましょう！

[temp id=2]

理由はさておきVBAのパスワードを解除したくなることってありませんか？

自分で作ったマクロにパスワードをかけたのに肝心の合言葉を忘れてしまって中身を直せない、なんて話は私も身に覚えがあります

古くはバイナリエディタで書き換える手もありましたが、今はVBAのプログラムを実行するだけでロックされたコードを確認できるようになっています

このページでは自分のファイル(自作マクロのパスワード忘れ)を救済する前提で手順をまとめます、他人や業務で受け取ったファイルへ無断で使うものではないので、そこだけ先にお伝えしておきますね

そもそもVBAのパスワード保護とは

手順に入る前に、なぜパスワードがかかっているのに回避できてしまうのかを軽く押さえておきます

VBAProject(マクロのコードを束ねている入れ物)にかけるパスワードは、ファイルの中身をガッチリ暗号化しているわけではなくて、エディタ上でコードを表示させないための制限に近い仕組みです

正しいパスワードを入れたかどうかをExcel側が確認して、合っていればコードを開く、という判定をしているだけなんですね

裏を返すと、その判定の部分に「もう正解が入りましたよ」と思い込ませることができれば、パスワードを知らなくてもコードが開けてしまうわけです

今回紹介するプログラムは、まさにこの判定をすり抜けるアプローチをとっています、つまりVBAのパスワードはセキュリティとしては弱めで、おまけ程度の鍵だと思っておくのが現実的です

解除手順

細かい操作はほとんどないので、サクッと4ステップにまとめました

保護解除プログラム

実際に使うプログラムはこちらなので、新規ファイルの標準モジュールにコピペでどうぞ↓↓

Option Explicit
   
Private Const PAGE_EXECUTE_READWRITE = &H40
   
Private Declare PtrSafe Sub MoveMemory Lib "kernel32" Alias "RtlMoveMemory" (Destination As LongPtr, Source As LongPtr, ByVal Length As LongPtr)
Private Declare PtrSafe Function VirtualProtect Lib "kernel32" (lpAddress As LongPtr, ByVal dwSize As LongPtr, ByVal flNewProtect As LongPtr, lpflOldProtect As LongPtr) As LongPtr
Private Declare PtrSafe Function GetModuleHandleA Lib "kernel32" (ByVal lpModuleName As String) As LongPtr
Private Declare PtrSafe Function GetProcAddress Lib "kernel32" (ByVal hModule As LongPtr, ByVal lpProcName As String) As LongPtr
Private Declare PtrSafe Function DialogBoxParam Lib "user32" Alias "DialogBoxParamA" (ByVal hInstance As LongPtr, ByVal pTemplateName As LongPtr, ByVal hWndParent As LongPtr, ByVal lpDialogFunc As LongPtr, ByVal dwInitParam As LongPtr) As Integer
 
Dim HookBytes(0 To 5) As Byte
Dim OriginBytes(0 To 5) As Byte
Dim pFunc As LongPtr
Dim Flag As Boolean
   
Private Function GetPtr(ByVal Value As LongPtr) As LongPtr
  GetPtr = Value
End Function
   
Private Sub RecoverBytes()
  If Flag Then MoveMemory ByVal pFunc, ByVal VarPtr(OriginBytes(0)), 6
End Sub
   
Public Function Hook() As Boolean
  Dim TmpBytes(0 To 5) As Byte
  Dim p As LongPtr
  Dim OriginProtect As LongPtr
   
  Hook = False
  pFunc = GetProcAddress(GetModuleHandleA("user32.dll"), "DialogBoxParamA")
  If VirtualProtect(ByVal pFunc, 6, PAGE_EXECUTE_READWRITE, OriginProtect) <> 0 Then
    MoveMemory ByVal VarPtr(TmpBytes(0)), ByVal pFunc, 6
    If TmpBytes(0) <> &H68 Then
      MoveMemory ByVal VarPtr(OriginBytes(0)), ByVal pFunc, 6
      p = GetPtr(AddressOf MyDialogBoxParam)
      HookBytes(0) = &H68
      MoveMemory ByVal VarPtr(HookBytes(1)), ByVal VarPtr(p), 4
      HookBytes(5) = &HC3
      MoveMemory ByVal pFunc, ByVal VarPtr(HookBytes(0)), 6
      Flag = True
      Hook = True
    End If
  End If
End Function
   
Private Function MyDialogBoxParam(ByVal hInstance As LongPtr, ByVal pTemplateName As LongPtr, ByVal hWndParent As LongPtr, ByVal lpDialogFunc As LongPtr, ByVal dwInitParam As LongPtr) As Integer
  If pTemplateName = 4070 Then
    MyDialogBoxParam = 1
  Else
    RecoverBytes
    MyDialogBoxParam = DialogBoxParam(hInstance, pTemplateName, hWndParent, lpDialogFunc, dwInitParam)
    Hook
  End If
End Function
   
Public Sub VBAProjectパスワード解除()
  If Hook Then
    MsgBox "VBAProjectのパスワード解除成功！", vbInformation, "Congratulations"
  End If
End Sub

このコードがやっているのは、Windowsがダイアログを出すときに呼び出すDialogBoxParamAという関数の動きを横取りすることです

VBAのパスワード入力ダイアログが出ようとした瞬間に「もう正解が返ってきたことにする」よう差し替えるイメージで、専門的にはAPIフックと呼ばれる手法ですね

差し替えのためにVirtualProtectやMoveMemoryといったメモリ操作の関数を使っていて、ここがエラーになりやすいので軽くだけ補足しておきます

掲載しているのは64bit版Excelに対応したPtrSafe版です、各宣言にPtrSafeが付いていて型がLongPtrになっているのがその印で、今どきのExcel(Microsoft 365含む)なら基本このまま動きます

もし古い32bit環境でコンパイルエラーが出る場合は、宣言の書き方を32bit向けに直す必要があります、このあたりはFAQでも触れるので、エラーで止まった方はそちらも見てみてください

操作動画

手順を動画化しただけですが、文字だけだと伝わりにくい時の参考にどうぞ

注意点

便利な手順ですが、いくつか性質を知っておかないと「あれ？元に戻ってる？」と戸惑うことになります

大事なのは、この手順を使ってもパスワードそのものが消えるわけではないという点です

あくまでメモリ上で一時的にダイアログを回避しているだけなので、上書き保存をしてもファイルを閉じて開き直すと、また同じパスワードが効いた状態に戻ります

そういう意味では「パスワードを解除する」というよりこっそり中身を覗くと言ったほうがしっくりくるかもしれないですね

もう一点、メモリを直接書き換える手法なので、環境によっては実行時にExcelが落ちることもあります

大事なファイルでいきなり試すのは怖いので、事前にコピーをとってから作業するのが安心です

ちなみに今回のAPIフック以外にも、古い.xls形式向けにバイナリエディタでvbaProject.binの中の「DPB」というキーを書き換える方法も知られています

こちらは仕組みとしては今でも紹介されていますが、書き換えをミスるとファイルが壊れる可能性があるので、扱いに慣れていないうちは今回のプログラム実行のほうが手軽だと思います、似た発想の「保護を後から外す」話として、PythonのExe化を逆コンパイルで覗く記事も書いているので興味があればどうぞ

PyInstallerでExe化したPythonを逆コンパイルする方法

使うときのマナー

仕組みを知ると応用したくなるところですが、使いどころは落ち着いて見極めたいですね

この手順が役に立つのは、自分で作ったマクロのパスワードを忘れてしまったような、自分のファイルを救済する場面です

一方で、他人が作ったファイルや業務で配布されたファイルにはパスワードをかけた人の意図があります、中を見たいときは作成者や権利者に許可をとるのが筋だと思います

このあたりは時点や状況によって考え方も変わりうるところなので、断定はしませんが、少なくとも無断で他人のロックを外して回るような使い方は避けておくのが無難です

よくある質問

つまずきやすいポイントをQ&A形式でまとめておきます

あとがき

VBAパスワードの解除方法は調べるといくつか出てきますが、今回のプログラム実行が一番手軽な気がします

仕組みとしてはパスワード入力の判定をすり抜けているだけなので、過信せず自分のファイルの救済に役立ててもらえたら嬉しいです

VBAの独学に効く本PR

Excel VBA塾【動画×本で学ぶ!】

たてばやし淳

Amazonで見る楽天で見る

パーフェクトExcel VBA

高橋宣成

Amazonで見る楽天で見る

Excel マクロ&VBA［実践ビジネス入門講座］完全版 第3版

国本温子

Amazonで見る楽天で見る

私のおすすめからランダムで3冊を表示しています

再帰処理とは

一言で表すと関数やプロシージャが自分自身を呼び出す処理のこと

処理方法の話なので当然VBAだけでなく他のプログラム言語でも使われる処理ですが、私が一番しっくりきたパソコンのフォルダ潜りながらフォルダ情報を収集するプログラムを例に解説します

サンプルプログラム

メチャメチャシンプルなサンプルプログラムです

何をやっているかと言うとファイルが保存されているフォルダを起点にサブフォルダを照会して、今度はそのフォルダを起点にしてサブフォルダを照会して・・・を繰り返します

Sub AddFolderList()
'------------------------------
' メインプロシージャ
'------------------------------
Dim objFso As New Scripting.FileSystemObject

Debug.Print "RootFolder：" & ThisWorkbook.Path
Call SearchFolder(objFso.GetFolder(ThisWorkbook.Path), 1)
End Sub
'------------------------------------------------------------------------------------------
Function SearchFolder(TargetFolder As Scripting.Folder, FolderLv As Long)
'------------------------------
' 再帰処理用プロシージャ
'------------------------------
Dim objFld As Scripting.Folder

Call GetFolderInfo(TargetFolder, FolderLv)
For Each objFld In TargetFolder.SubFolders
    Call SearchFolder(objFld, FolderLv + 1)
Next
End Function
'------------------------------------------------------------------------------------------
Function GetFolderInfo(TargetFolder As Scripting.Folder, FolderLv As Long)
'------------------------------
' フォルダ情報をイミディエイトに表示
'------------------------------
Debug.Print String(FolderLv, "　") & "FolderName：" & TargetFolder.Name
Debug.Print String(FolderLv + 2, "　") & "├FileCount：" & TargetFolder.Files.Count
Debug.Print String(FolderLv + 2, "　") & "├TotalSize：" & TargetFolder.Files.Count
Debug.Print String(FolderLv + 2, "　") & "├CreateDate：" & TargetFolder.DateCreated
Debug.Print String(FolderLv + 2, "　") & "└UpdateDate：" & TargetFolder.DateLastModified
End Function

再帰処理のイメージ

まず再帰処理を使わずに再現しようとした時のプログラムがこちら

フォルダ1-Aを起点とするとその中にフォルダ2-A/2-Bがある、2-Aの中にフォルダ3-Aがあってさらにその中にフォルダ4-A/4-B/4-Cがある

事前に構造がわかっていれば↓の別サンプルのようにFor Nextを必要回数入れ子にして対応することもできますが例えば4-Aの中に新しいフォルダが作成された時、階層がもう一段階深くなるので入れ子が足りず取得できません

無理矢理運用するなら10回くらい入れ子にしておけば大体大丈夫ですがそれではイマイチ

Function SearchFolder(main As Scripting.Folder)
'------------------------------
' 再帰処理しない時のプログラム例
'------------------------------
Dim sub1 As Scripting.Folder, sub2 As Scripting.Folder, sub3 As Scripting.Folder

Call GetFolderInfo(main, 1)
For Each sub1 In TargetFolder.SubFolders
    Call SearchFolder(sub1, 2)
    For Each sub2 In sub1.SubFolders
        Call SearchFolder(sub2, 3)
        For Each sub3 In sub2.SubFolders
            Call SearchFolder(sub3, 4)
        Next
    Next
Next
End Function

そしてこちらが再帰処理のイメージ

Mainフォルダに1-Aを代入すると2-A/2-BがSubフォルダとして取得できる

Subフォルダ2-AをMainフォルダに代入すると次は3-AがSubフォルダに、続いて3-AをMainフォルダにすると4-A/4-B/4-CがSubフォルダになる

ポイントはここでさらに下の階層があればループが続くし、なければここで処理が終わるところ

プログラムも短くスッキリした感じになります

再帰処理のメリット・デメリット

結局のところ再帰処理って必要な処理なの？メリット・デメリットは？ってことでまとめてみます

メリット

繰り返すべき回数が可変なプログラムでも対応することができます

今回のフォルダであれば起点から3階層潜ったわけですが当然もっと深い階層がある可能性もありますがサブフォルダがあればループする仕様になるのでプログラムとして最適化できます

デメリット

再帰処理は処理の途中で別のことに手を付けるようなことなのでループする度メモリを使うことになり、やり過ぎはメモリ不足を招く可能性があります

もう一点はデメリットと言うより注意点になりますが、処理方法については無限ループになってしまいます

例えばこんな処理

'==============================
' 無限ループになるプログラム
'==============================
Sub sample()
Dim i As Long

i = 1
Call AdditionFunc(i)
End Sub
'-------------------------------
Function AdditionFunc(i As Long)
Debug.Print i
Call AdditionFunc(i + 1)
End Function

加算し続けるだけで終わりのない無限処理になってしまうのでループに条件を付けるもしくはループを抜ける分岐を付けてあげる必要があります

'==============================
' 無限ループを回避したプログラム
'==============================
Sub sample()
Dim i As Long

i = 1
Call AdditionFunc(i)
End Sub
'------------------------------
Function AdditionFunc(i As Long)
Debug.Print i
'---10未満の時だけ再帰処理する
If i < 10 Then
    AdditionFunc = AdditionFunc(i + 1)
End If
End Function

あとがき

再帰処理をフォルダ検索を例に解説してみました

わかるようでわからない再帰処理も実例があるとしっくりきませんか？私はきましたw

他の言語でも考え方や書き方は同じなので参考にしてみてください

ツールの仕様

VBAのことはいいからツールを使ってみたい！って方向けにまずはツールの仕様から

設定項目

絵が合った方が早いのでまずはエクセルの切り抜きから

対象フォルダ指定（グレー背景箇所）

まずは取得対象とするフォルダの指定

サブフォルダも取得するようにすると対象フォルダ以下全てのフォルダが取得対象に

ちなみにフォルダ名のところでダブルクリックするとダイアログで対象フォルダを選べる仕様にしています

フォルダ名の指定（青背景箇所）

次はフォルダ名の指定

各項目の入力条件で取得対象を制限できます

パイプ文字は”|”のことでキーボードで言うと右上の”\”をshift押しながら押下で入力できます

ファイル名の指定（緑背景箇所）

ファイル名の指定もフォルダと同じ方法

このファイル名に拡張子は含まないので注意

拡張子の指定（オレンジ背景箇所）

フォルダ名、ファイル名の指定と同じ

.（ドット）はいらないのでエクセルなら”xlsx”でOK

プログラムについて

ここからVBAの説明に移ります

コピペでそのまま使えるプログラムと各プロシージャの説明を

必要な参照設定

フォルダ・ファイルの情報を扱うので必須レベルな”FileSystemObject“を使用しますから”Microsoft Scripting Runtime“の参照をどうぞ

その他はありませんので魔改造する時に必要に応じて

コピペ用 プログラムの全貌

説明なんぞ不要でファイルがあればいい、プログラムがあればいいって方向けに最初にVBAの全プログラムとそのまま使えるマクロファイルです

長ったらしいので畳んでますが見たい方は広げてください

Option Explicit
Enum lngCol
    file_name = 1
    ext_name
    file_size
    create_date
    mod_date
    file_path
    file_path_split
End Enum
Dim objFso As New Scripting.FileSystemObject
Sub GetFileList()
Dim ws As Worksheet
Dim target_folder As String

'---起点フォルダの確認
target_folder = Trim(Range("TARGET_FOLDER").Value)
If objFso.FolderExists(target_folder) = False Then
    MsgBox "対象フォルダが見つかりません", vbCritical
    Exit Sub
End If

'---フォルダ名の一致判定
If Len(Trim(Range("FOLDER_NAME").Value)) > 0 Then
    If Len(Trim(Range("FOLDER_MATCH_TYPE").Value)) = 0 Then
        MsgBox "フォルダ名の一致タイプ を入力してください", vbCritical
        Exit Sub
    End If
    If Len(Trim(Range("FOLDER_MATCH_PATTERN").Value)) = 0 Then
        MsgBox "フォルダ名の一致パターン を入力してください", vbCritical
        Exit Sub
    End If
Else
    Range("FOLDER_NAME").Value = Trim(Range("FOLDER_NAME").Value)
End If

'---ファイル名の一致判定
If Len(Trim(Range("FILE_NAME").Value)) > 0 Then
    If Len(Trim(Range("FILE_MATCH_TYPE").Value)) = 0 Then
        MsgBox "フォルダ名の一致タイプ を入力してください", vbCritical
        Exit Sub
    End If
    If Len(Trim(Range("FILE_MATCH_PATTERN").Value)) = 0 Then
        MsgBox "フォルダ名の一致パターン を入力してください", vbCritical
        Exit Sub
    End If
End If

'---拡張子の一致判定
If Len(Trim(Range("EXT_NAME").Value)) > 0 Then
    If Len(Trim(Range("EXT_MATCH_TYPE").Value)) = 0 Then
        MsgBox "拡張子の一致タイプ を入力してください", vbCritical
        Exit Sub
    End If
    If Len(Trim(Range("EXT_MATCH_PATTERN").Value)) = 0 Then
        MsgBox "拡張子の一致パターン を入力してください", vbCritical
        Exit Sub
    End If
End If


Set ws = Sheet2
'---テーブルをリセットする
With ws
    .Select
    '---テーブルが空だとエラーになるのでエラーを無視するようにする
    On Error Resume Next
    .Range(Range("FILE_TABLE").Address).EntireRow.Delete
    On Error GoTo 0
End With

'---まず指定フォルダのファイルを収集する
If Len(Trim(Range("FOLDER_NAME").Value)) > 0 Then
    '---指定の場合一致したらファイル情報を取得する
    If Range("FOLDER_MATCH_PATTERN").Value = "指定" Then
        If in_array(objFso.GetFolder(target_folder).Name, Split(Range("FOLDER_NAME").Value, "|"), Range("FOLDER_MATCH_TYPE").Value) = True Then
            Call GetFileData(ws, Range("FOLDER_NAME").Value)
        End If
    End If
    '---除外の場合は不一致ならファイル情報取得して再帰処理する
    If Range("FOLDER_MATCH_PATTERN").Value = "除外" Then
        If in_array(objFso.GetFolder(target_folder).Name, Split(Range("FOLDER_NAME").Value, "|"), Range("FOLDER_MATCH_TYPE").Value) = False Then
            Call GetFileData(ws, Range("FOLDER_NAME").Value)
        End If
    End If
Else
    Call GetFileData(ws, Range("TARGET_FOLDER").Value)
End If


'-サブフォルダを対象とするか
If Range("TARGET_SUBFOLDER").Value = "する" Then
    Call GetSubFoler(ws, target_folder)
End If
Set ws = Nothing
Application.StatusBar = False

'---先頭行が空白だったら（絶対空白のはず）削除する
If Len(Trim(Range("FILE_TABLE").Item(1).Value)) = 0 Then
    On Error Resume Next
    Range("FILE_TABLE").ListObject.ListRows(1).Delete
    On Error GoTo 0
End If

Range("FILE_TABLE").Item(1).Select
MsgBox "終了しました"
End Sub
Sub DeleteFileList()
Dim ws As Worksheet
Set ws = Sheet2
'---テーブルをリセットする
With ws
    .Select
    On Error Resume Next
    .Range(Range("FILE_TABLE").Address).EntireRow.Delete
    On Error GoTo 0
End With
Set ws = Nothing

Range("FILE_TABLE").Item(1).Select
MsgBox "終了しました"
End Sub
Private Function GetFileData(ws As Worksheet, target_folder As String)
'======================================================================
' 指定フォルダの中にあるファイル情報を取得してリストに反映する
'======================================================================
Dim lngRow As Long
Dim file_path As String
Dim objFile As Scripting.File
Dim get_file_bool As Boolean

Application.StatusBar = target_folder & " のファイル情報を取得中・・・"
For Each objFile In objFso.GetFolder(target_folder).Files
    '---ファイルの取得判定の初期値を設定（True）
    get_file_bool = True
    '---ファイル名検索に指定があったら
    If Len(Trim(Range("FILE_NAME").Value)) > 0 Then
        '---ファイル名（拡張子除く）が条件と一致しているか確認
        If in_array(objFso.GetBaseName(objFile.Name), Split(Range("FILE_NAME").Value, "|"), Range("FILE_MATCH_TYPE").Value) = IIf(Range("FILE_MATCH_PATTERN").Value = "指定", True, False) Then
            get_file_bool = True
        Else
            get_file_bool = False
            GoTo continue
        End If
    End If
    
    '---拡張子に指定があったら
    If Len(Trim(Range("EXT_NAME").Value)) > 0 Then
        If in_array(objFso.GetExtensionName(objFile.Name), Split(Range("EXT_NAME").Value, "|"), Range("EXT_MATCH_TYPE").Value) = IIf(Range("EXT_MATCH_PATTERN").Value = "指定", True, False) Then
            get_file_bool = True
        Else
            get_file_bool = False
            GoTo continue
        End If
    End If
    
    '---取得対象と判定されたら情報を取得して書き出す
    If get_file_bool = True Then
        With ws
            .Select
            '---テーブルに行を追加する
            Range("FILE_TABLE").ListObject.ListRows.Add AlwaysInsert:=False
            lngRow = Range("FILE_TABLE").Item(Range("FILE_TABLE").Cells.Count).Row
            .Cells(lngRow, lngCol.file_name).Value = objFile.Name
            .Cells(lngRow, lngCol.ext_name).Value = objFso.GetExtensionName(objFile.Path)
            .Cells(lngRow, lngCol.file_size).Value = objFile.Size
            .Cells(lngRow, lngCol.create_date).Value = objFile.DateCreated
            .Cells(lngRow, lngCol.mod_date).Value = objFile.DateLastModified
            file_path = Replace(objFile.Path, "\" & objFile.Name, "")
            .Cells(lngRow, lngCol.file_path).Value = Replace(objFile.Path, "\" & objFile.Name, "")
            .Cells(lngRow, lngCol.file_path_split).Resize(, UBound(Split(file_path, "\")) + 1) = Split(file_path, "\")
        End With
    End If
continue:
Next
End Function
Private Function GetSubFoler(ws As Worksheet, target_folder As String)
'======================================================================
' 再帰処理でフォルダを潜りながらそのフォルダのファイルを取得する
'======================================================================
Dim objFld As Scripting.Folder

For Each objFld In objFso.GetFolder(target_folder).SubFolders
    '---フォルダ名検索に指定があったら
    If Len(Trim(Range("FOLDER_NAME").Value)) > 0 Then
        '---指定の場合一致したらファイル情報を取得する
        If Range("FOLDER_MATCH_PATTERN").Value = "指定" Then
            If in_array(objFld.Name, Split(Range("FOLDER_NAME").Value, "|"), Range("FOLDER_MATCH_TYPE").Value) = True Then
                Call GetFileData(ws, objFld.Path)
            End If
            '---どちらにしても再帰処理はかける
            Call GetSubFoler(ws, objFld.Path)
        End If
        '---除外の場合は不一致ならファイル情報取得して再帰処理する
        If Range("FOLDER_MATCH_PATTERN").Value = "除外" Then
            If in_array(objFld.Name, Split(Range("FOLDER_NAME").Value, "|"), Range("FOLDER_MATCH_TYPE").Value) = False Then
                Call GetFileData(ws, objFld.Path)
                Call GetSubFoler(ws, objFld.Path)
            End If
        End If
    Else
        Call GetFileData(ws, objFld.Path)
        Call GetSubFoler(ws, objFld.Path)
    End If
Next
End Function
Private Function in_array(target_str As String, target_array As Variant, Optional match_type As String = "完全一致") As Boolean
'======================================================================
' パターンに合わせて一致判定を返す
'======================================================================
Dim arr As Variant

For Each arr In target_array
    Select Case match_type
        Case "完全一致"
            If LCase(target_str) = LCase(arr) Then
                in_array = True
                Exit Function
            End If
        Case "部分一致"
            If LCase(target_str) Like "*" & LCase(arr) & "*" Then
                in_array = True
                Exit Function
            End If
        Case "前方一致"
            If LCase(target_str) Like LCase(arr) & "*" Then
                in_array = True
                Exit Function
            End If
        Case "後方一致"
            If LCase(target_str) Like "*" & LCase(arr) Then
                in_array = True
                Exit Function
            End If
        Case Else
    End Select
Next
in_array = False
End Function

ここからはプログラムをプロシージャ別に解説していきます

共通変数

Option Explicit
Enum lngCol
    file_name = 1
    ext_name
    file_size
    create_date
    mod_date
    file_path
End Enum
Dim objFso As New Scripting.FileSystemObject

個人的な話ですが、昔はプロシージャ―の外に書く共通変数にしたがっていた時期がありましたが最近はなるべく共通変数は減らして値格納する変数はNGにしています

Enum（列挙型）はExcelならではですが、列番号を宣言してあげると後から項目追加・削除したり編集する可能性があるなら便利ですよね

GetFileList（メインプロシージャ―）

Sub GetFileList()
Dim ws As Worksheet
Dim target_folder As String

'---起点フォルダの確認
target_folder = Trim(Range("TARGET_FOLDER").Value)
If objFso.FolderExists(target_folder) = False Then
    MsgBox "対象フォルダが見つかりません", vbCritical
    Exit Sub
End If

'---フォルダ名の一致判定
If Len(Trim(Range("FOLDER_NAME").Value)) > 0 Then
    If Len(Trim(Range("FOLDER_MATCH_TYPE").Value)) = 0 Then
        MsgBox "フォルダ名の一致タイプ を入力してください", vbCritical
        Exit Sub
    End If
    If Len(Trim(Range("FOLDER_MATCH_PATTERN").Value)) = 0 Then
        MsgBox "フォルダ名の一致パターン を入力してください", vbCritical
        Exit Sub
    End If
Else
    Range("FOLDER_NAME").Value = Trim(Range("FOLDER_NAME").Value)
End If

'---ファイル名の一致判定
If Len(Trim(Range("FILE_NAME").Value)) > 0 Then
    If Len(Trim(Range("FILE_MATCH_TYPE").Value)) = 0 Then
        MsgBox "フォルダ名の一致タイプ を入力してください", vbCritical
        Exit Sub
    End If
    If Len(Trim(Range("FILE_MATCH_PATTERN").Value)) = 0 Then
        MsgBox "フォルダ名の一致パターン を入力してください", vbCritical
        Exit Sub
    End If
End If

'---拡張子の一致判定
If Len(Trim(Range("EXT_NAME").Value)) > 0 Then
    If Len(Trim(Range("EXT_MATCH_TYPE").Value)) = 0 Then
        MsgBox "拡張子の一致タイプ を入力してください", vbCritical
        Exit Sub
    End If
    If Len(Trim(Range("EXT_MATCH_PATTERN").Value)) = 0 Then
        MsgBox "拡張子の一致パターン を入力してください", vbCritical
        Exit Sub
    End If
End If


Set ws = Sheet2
'---テーブルをリセットする
With ws
    .Select
    '---テーブルが空だとエラーになるのでエラーを無視するようにする
    On Error Resume Next
    .Range(Range("FILE_TABLE").Address).EntireRow.Delete
    On Error GoTo 0
End With

'---まず指定フォルダのファイルを収集する
If Len(Trim(Range("FOLDER_NAME").Value)) > 0 Then
    '---指定の場合一致したらファイル情報を取得する
    If Range("FOLDER_MATCH_PATTERN").Value = "指定" Then
        If in_array(objFso.GetFolder(target_folder).Name, Split(Range("FOLDER_NAME").Value, "|"), Range("FOLDER_MATCH_TYPE").Value) = True Then
            Call GetFileData(ws, Range("FOLDER_NAME").Value)
        End If
    End If
    '---除外の場合は不一致ならファイル情報取得して再帰処理する
    If Range("FOLDER_MATCH_PATTERN").Value = "除外" Then
        If in_array(objFso.GetFolder(target_folder).Name, Split(Range("FOLDER_NAME").Value, "|"), Range("FOLDER_MATCH_TYPE").Value) = False Then
            Call GetFileData(ws, Range("FOLDER_NAME").Value)
        End If
    End If
Else
    Call GetFileData(ws, Range("TARGET_FOLDER").Value)
End If


'-サブフォルダを対象とするか
If Range("TARGET_SUBFOLDER").Value = "する" Then
    Call GetSubFoler(ws, target_folder)
End If
Set ws = Nothing
Application.StatusBar = False

'---先頭行が空白だったら（絶対空白のはず）削除する
If Len(Trim(Range("FILE_TABLE").Item(1).Value)) = 0 Then
    On Error Resume Next
    Range("FILE_TABLE").ListObject.ListRows(1).Delete
    On Error GoTo 0
End If

Range("FILE_TABLE").Item(1).Select
MsgBox "終了しました"
End Sub

長いように見えてやっていることは

1. エクセルで入力した内容（条件）をチェックする
2. 出力先のシート（厳密にはテーブル）をリセットする
3. 指定したフォルダのファイル情報を取得する

だけです

当たり前ですがエクセルで設定できる項目に比例してソースが長くなってしまうのはやむなし

GetFileData

Private Function GetFileData(ws As Worksheet, target_folder As String)
'======================================================================
' 指定フォルダの中にあるファイル情報を取得してリストに反映する
'======================================================================
Dim lngRow As Long
Dim file_path As String
Dim objFile As Scripting.File
Dim get_file_bool As Boolean

Application.StatusBar = target_folder & " のファイル情報を取得中・・・"
For Each objFile In objFso.GetFolder(target_folder).Files
    '---ファイルの取得判定の初期値を設定（True）
    get_file_bool = True
    '---ファイル名検索に指定があったら
    If Len(Trim(Range("FILE_NAME").Value)) > 0 Then
        '---ファイル名（拡張子除く）が条件と一致しているか確認
        If in_array(objFso.GetBaseName(objFile.Name), Split(Range("FILE_NAME").Value, "|"), Range("FILE_MATCH_TYPE").Value) = IIf(Range("FILE_MATCH_PATTERN").Value = "指定", True, False) Then
            get_file_bool = True
        Else
            get_file_bool = False
            GoTo continue
        End If
    End If
    
    '---拡張子に指定があったら
    If Len(Trim(Range("EXT_NAME").Value)) > 0 Then
        If in_array(objFso.GetExtensionName(objFile.Name), Split(Range("EXT_NAME").Value, "|"), Range("EXT_MATCH_TYPE").Value) = IIf(Range("EXT_MATCH_PATTERN").Value = "指定", True, False) Then
            get_file_bool = True
        Else
            get_file_bool = False
            GoTo continue
        End If
    End If
    
    '---取得対象と判定されたら情報を取得して書き出す
    If get_file_bool = True Then
        With ws
            .Select
            '---テーブルに行を追加する
            Range("FILE_TABLE").ListObject.ListRows.Add AlwaysInsert:=False
            lngRow = Range("FILE_TABLE").Item(Range("FILE_TABLE").Cells.Count).Row
            .Cells(lngRow, lngCol.file_name).Value = objFile.Name
            .Cells(lngRow, lngCol.ext_name).Value = objFso.GetExtensionName(objFile.Path)
            .Cells(lngRow, lngCol.file_size).Value = objFile.Size
            .Cells(lngRow, lngCol.create_date).Value = objFile.DateCreated
            .Cells(lngRow, lngCol.mod_date).Value = objFile.DateLastModified
            file_path = Replace(objFile.Path, "\" & objFile.Name, "")
            .Cells(lngRow, lngCol.file_path).Value = Replace(objFile.Path, "\" & objFile.Name, "")
            .Cells(lngRow, lngCol.file_path_split).Resize(, UBound(Split(file_path, "\")) + 1) = Split(file_path, "\")
        End With
    End If
continue:
Next
End Function

まず今回のようなループが多いプログラムはステータスバーに進捗状況を表示してあげると親切

他の言語に慣れるとVBAのForループにcontinueが無いのが地味にストレスなんでGoToで無理矢理再現したことと、PHPで出会ったin_arrayは後述していますがVBAにない関数は自作してしまえってことでこちらも再現しただけの関数を準備しました

他には出力先をテーブル化しているので最下行の指定が通例とちょっと違うことと、フォルダパスを”\”で区切った配列を一気に反映させるためにResizeを使っているところがミソ

細かいこと書きましたがざっくりやっていることは↓↓だけ

1. 引数にあるフォルダ内のファイルをFor Eachでサーチ
2. SETシートで指定したファイルと拡張子の条件と照合
3. 条件一致していればLISTシートにあるテーブルへ書き込む

GetSubFoler

Private Function GetSubFoler(ws As Worksheet, target_folder As String)
'======================================================================
' 再帰処理でフォルダを潜りながらそのフォルダのファイルを取得する
'======================================================================
Dim objFld As Scripting.Folder

For Each objFld In objFso.GetFolder(target_folder).SubFolders
    '---フォルダ名検索に指定があったら
    If Len(Trim(Range("FOLDER_NAME").Value)) > 0 Then
        '---指定の場合一致したらファイル情報を取得する
        If Range("FOLDER_MATCH_PATTERN").Value = "指定" Then
            If in_array(objFld.Name, Split(Range("FOLDER_NAME").Value, "|"), Range("FOLDER_MATCH_TYPE").Value) = True Then
                Call GetFileData(ws, objFld.Path)
            End If
            '---どちらにしても再帰処理はかける
            Call GetSubFoler(ws, objFld.Path)
        End If
        '---除外の場合は不一致ならファイル情報取得して再帰処理する
        If Range("FOLDER_MATCH_PATTERN").Value = "除外" Then
            If in_array(objFld.Name, Split(Range("FOLDER_NAME").Value, "|"), Range("FOLDER_MATCH_TYPE").Value) = False Then
                Call GetFileData(ws, objFld.Path)
                Call GetSubFoler(ws, objFld.Path)
            End If
        End If
    Else
        Call GetFileData(ws, objFld.Path)
        Call GetSubFoler(ws, objFld.Path)
    End If
Next
End Function

ここでもin_arrayが登場してるのですが、条件指定を複数できるようにしてるので重宝します

ここでのポイントは再帰処理しているところだけで、これまで通りやっていることを並べると

1. SETシートで指定したフォルダの条件と照合
2. 一致しているもしくは条件指定していないならファイル情報を取得
3. 次の階層のフォルダを同じことを繰り返す

再帰処理はその内説明ページ作ります

in_array

Private Function in_array(target_str As String, target_array As Variant, Optional match_type As String = "完全一致") As Boolean
'======================================================================
' パターンに合わせて一致判定を返す
'======================================================================
Dim arr As Variant

For Each arr In target_array
    Select Case match_type
        Case "完全一致"
            If LCase(target_str) = LCase(arr) Then
                in_array = True
                Exit Function
            End If
        Case "部分一致"
            If LCase(target_str) Like "*" & LCase(arr) & "*" Then
                in_array = True
                Exit Function
            End If
        Case "前方一致"
            If LCase(target_str) Like LCase(arr) & "*" Then
                in_array = True
                Exit Function
            End If
        Case "後方一致"
            If LCase(target_str) Like "*" & LCase(arr) Then
                in_array = True
                Exit Function
            End If
        Case Else
    End Select
Next
in_array = False
End Function

本家のin_arrayは完全一致だけですが今回の使用目的的にも自作関数なので一致条件を分岐で作りましたが、指定の文字が配列の中にあるかをチェックする関数

Dictionary型で無理矢理取り扱えばExistsもありますが、完全一致以外も処理したいので結局自作関数がベストかと

余談 兼 フリーソフト紹介

今回せっかくVBAで作ったので分解して説明しましたが、ファイルリストを作りたいならフリーソフトのEverythingを使うと爆速で作成できます！

個人的にはWindowsの標準ソフトとして搭載してほしいくらいの便利ソフトなので興味がある方は是非！

窓の杜へのリンク

本家サイトへのリンク

あとがき

せっかく作ったので紹介してみましたが実のところ再帰処理さえ理解していれば9割くらい作れるお手軽プログラムに細かな設定を付け足しただけです

他にもExcelでツール作った時は同じように公開してますのでたまに覗きに来てくれると嬉しいです！