指定したフォルダ下のファイルの情報を取得する、というのは今となってはパワークエリでやるのが簡単便利。けれども、データがテーブル状になっておらず、いわゆるネ申Excelというのでしょうか、見た目重視セル結合しまくりのこっちのセルとあっちのセルからそれぞれ情報をとってきたい、というときには、VBAのほうが簡単。
それを教えてくれと言われたので、ここに記します。
１．やってみる内容
下図のようなフォーマットのエクセルファイルが一つのフォルダの下にあります。
マクロ実行ファイルの「基本情報」シートでフォルダパスと情報を取得するセル位置を指定し、出力シートに取得した情報を出力します。
VBAコードの中で「このセル」と指定したほうがコードがシンプルになるのですが、取得セルをマクロ実行ファイルのシートで指定する、というやり方で教えてほしいとのことだったので、そのようにしています。コードは複雑にはなりますが、シートのセルを変更すれば取得セルを変えられるので、汎用ツールとしても使えます。
２．組み立てを考える
まず、どうやって攻めていくかをざっくり考えてみましょう。
まず、「このフォルダから」っていうフォルダパスを特定しなければいけませんよね。
それから、そのフォルダ下のファイルを開いて、
セルから情報を取得して、出力シートに印字して、
終わったらファイルを閉じて、次のファイルを開く。
この繰り返し。
ざっくり図に起こしてみると、下図のイメージ。ちょっと長くなっちゃったので折り返しています。
さて、もちょっと細かく書き出してみると以下の感じ。
３のファイル名を取得する、はDir関数を使用します。Do Loop でファイル名が取得できなくなるまで繰り返します。
３．やってみる
（１）コメント～コード全文
まず、こうやって、ああやって、というのをコメントで書いていきます。
その日本語をVBAに起こしていきます。
だいたいこんな感じ。
コメントはシングルクォーテーション(‘)のあとに書きます。
Sub フォルダ下のファイル情報取得_()
'出力シート、基本情報シートをセット
'基本情報シートからターゲットフォルダパスを変数path_フォルダに代入
'ファイル名を取得し変数filenameに代入
'フォルダ内LOOP開始
'ファイルを読取専用で開く
'対象シートをセット
'基本情報シートのセル位置を開始行から最終行までループ
'元データシートの情報→出力シートに出力
'基本情報シート：次の行へ
'出力シート：次の列へ
'ファイルを保存せずに閉じる
'次のファイルを取得
'出力シートをアクティブに
'終了メッセージ表示
End Subで、最後には以下のようになりました。
Sub フォルダ下のファイル情報取得()
'画面更新ストップ
Application.ScreenUpdating = False
'出力シート、基本情報シートをセット
Dim ws_出力 As Worksheet, ws_基本情報 As Worksheet
Set ws_出力 = Worksheets("出力")
Set ws_基本情報 = Worksheets("基本情報")
'基本情報シートからターゲットフォルダパスを変数path_フォルダに代入
Dim path_フォルダ As String
path_フォルダ = ws_基本情報.Range("D2").Value & "\"
'Loop内で使用する変数
Dim filename As String
Dim wb As Workbook
Dim ws As Worksheet
Dim row_基本情報 As Long
Dim row_出力 As Long
Dim col_出力 As Long
'基本情報シートセル位置開始行をセット
Const row_基本情報_開始行 As Long = 6
'ファイル名を取得し変数filenameに代入
filename = Dir(path_フォルダ & "*.xlsx")
'出力シート出力開始行を代入
row_出力 = 2
'LOOP開始:filenameが空になるまで
Do Until filename = ""
'ファイルを読取専用で開く
Set wb = Workbooks.Open(filename:=path_フォルダ & filename, ReadOnly:=True)
'対象シートをセット
Set ws = wb.Worksheets(1)
'基本情報シートのセル位置を開始行から最終行までループ
'基本情報シート読取り行番号に開始行を代入
row_基本情報 = row_基本情報_開始行
'出力シート出力列に開始列を代入
col_出力 = 1
Do Until ws_基本情報.Range("C" & row_基本情報).Value = ""
'元データシートの情報→出力シートに出力
ws_出力.Cells(row_出力, col_出力).Value = ws.Range(ws_基本情報.Range("C" & row_基本情報).Value).Value
'基本情報シート：次の行へ
row_基本情報 = row_基本情報 + 1
'出力シート：次の列へ
col_出力 = col_出力 + 1
Loop
'ファイルを保存せずに閉じる
wb.Close False
'次のファイルを取得
filename = Dir()
'出力シート出力開始行をカウントアップ
row_出力 = row_出力 + 1
Loop
'出力シートをアクティブに
ws_出力.Activate
'終了メッセージ表示
MsgBox "出力完了"
'画面更新ストップを解除
Application.ScreenUpdating = True
End Subいろいろなアプローチ方法がありますので、これが正解、というのはないです。
とりあえずは「動けばいい」。
研鑽を積んでからは
・コンパクト
・わかりやすい
・効率的である
・変化に強い
コードを目指します。
（２）最初に設定すること
「変数の宣言を強制する」にチェックを付けておくことをお勧めします。
そうすると、モジュールの上部に Option Explicit というのが自動的に表示されるようになります。
なぜそうするのがお勧めかというと。。。TANAKA先生の記事を貼っておきます。
Office TANAKA 変数の宣言
VBAエディター＞ツール＞オプション
（３）コードを書いていく
コメントをVBAコードに起こしていくイメージです。
組み立てとVBAの書き方の基本さえできていれば、VBAコードは知らなくてもやりたいことを調べながら書けば大丈夫。組み立てにはこれまで手作業でエクセル作業をしてきた経験が役立ちます。
コードを書きながら解説を入れています。
かなり端折った説明になってしまいますが、不明な点はAIさんに教えてもらうか、ネットで調べるなどしてみてください。
'出力シート、基本情報シートをセット
Dim ws_出力 As Worksheet, ws_基本情報 As Worksheet
Set ws_出力 = Worksheets("出力")
Set ws_基本情報 = Worksheets("基本情報")シートのオブジェクト変数を宣言して、セットします。
WorksheetやWorkbookはオブジェクト変数のため、変数に代入する際に Set の記述が必要です。
超余談ですが、「なんで変数の方は Worksheet と単数なのにセットするときは WorkSheets と複数なの？」というと、ブック内に複数ある WorkSheetsコレクション の中から、シート名やシート番号を指定して一つの WorkSheet を指定するからです。
'基本情報シートからターゲットフォルダパスを変数path_フォルダに代入
Dim path_フォルダ As String
path_フォルダ = ws_基本情報.Range("D2").Value & "\"基本情報シートのD2セルの値を[path_フォルダ]に入れています。この後にファイル名を続けてファイルパスとする予定なので、事前にフォルダとファイル名の間に挟む \ をつなげておきます。
'Loop内で使用する変数
Dim filename As String
Dim wb As Workbook
Dim ws As Worksheet
Dim row_基本情報 As Long
Dim row_出力 As Long
Dim col_出力 As Longこれから繰り返し処理に入りますが、その前にループの中で使う変数をまとめて宣言しておきます。
変数の宣言個所はその変数を使う前であればどこでも大丈夫です。
全ての変数をまとめて最初に宣言するパターンもありますが、私は直前宣言派です。
ちなみに変数に日本語を使わない派でしたが最近日本語使う派に転向しました。最近読んだ書籍「ExcelVBA開発を超効率化するプログラミングテクニック」（深見祐士著）の影響です。（この記事の最後にお勧め書籍としてリンクを貼っています）
ちなみに 最初の数文字を打って ctrlキーとスペースキーを押すと 入力候補が出てきますので、宣言した後はアルファベット⇔日本語のキーボード切り替えをしなくてもだいたい行けます。
'基本情報シートセル位置開始行をセット
Const row_基本情報_開始行 As Long = 6基本情報シートのセル位置を読み取る開始行を[row_基本情報_開始行]に入れる。
ここは定数（あとで変化させない変数）なので Const で宣言しています。
Const は宣言と同時に値を代入します。
Dim で宣言して後で値を入れてもいいのですが、私は「これは動かさない値だよ」と主張する意味も込めて積極的に Const を使う派です。
'ファイル名を取得し変数filenameに代入
filename = Dir(path_フォルダ & "*.xlsx")出ました。このコードの真骨頂 Dir関数。
Dir(ファイルパス)とすると、拡張子付きのファイル名を返す関数です。
ないっす、という場合は空白が返ります。
ファイルパスにワイルドカードを使えるので、それを使用してこのフォルダの中のファイル名は何でもいい「ただしエクセルファイルね」という指定を[.xlsx]と拡張子を指定することでしています。
次に Dir() を呼び出すと、まだとってきていないファイル名を出してくれるんです。
それを利用して、フォルダ下のファイルを次々に呼び出します。
ちなみにファイルパスとは「このフォルダの下のこのフォルダの中のXXXという名前のファイル」という目的のファイルまでの道案内の地図。。。いや、道案内のメモ。といった理解でよいかと思います。
パス、絶対パス、相対パス、ルートパスって何？
Dir関数の説明は長くなるので、私がよく利用する神髄先生とTANAKA先生の解説記事を貼っておきます。
Excelの神髄 第79回ファイル操作Ⅰ（Dir）
Office TANAKA Dir
Office TANAKA Dir関数の注意点
'出力シート出力開始行を代入
row_出力 = 2Loopに入る前に出力開始行をセットしておきます。ファイルごとに1行ずつ下にずらしていきます。
基本情報シートの開始行はわざわざConstで宣言して変数に入れたのに、こっちはいきなり数値で指定？と思われた方もいるかもしれません。何の違いが？というと。。。気分です。。。
基本情報シートの開始行も数値で指定してもよいのですが、Constの説明も入れたかったから。。。
基本的にはコードの中でセル位置などを直接指定するより、わかりやすいところでConstでセットしておくほうが好みです。コードの途中で突然数値で指定することを「マジックナンバー」というそうで、避けるほうが良いとされているようです。
マジックナンバーを避ける
ま、気にするのは達人になってからでいいですね。
'LOOP開始:filenameが空になるまで
Do Until filename = ""
'ファイルを読取専用で開く
Set wb = Workbooks.Open(filename:=path_フォルダ & filename, ReadOnly:=True)Loopの始まりを書きます。始まりを書いたら終わりを書いちゃうのがお勧めです。
そのあとで中の部分を書いていきます。
以下、対応する終わりの部分。
'ファイルを保存せずに閉じる
wb.Close False
'次のファイルを取得
filename = Dir()
'出力シート出力開始行をカウントアップ
row_出力 = row_出力 + 1
LoopDo Until filename = “” ～ Loop
[filename]が空文字になるまで繰り返します。
Set wb = Workbooks.Open(filename:=path_フォルダ & filename, ReadOnly:=True)
ファイルを読取専用で開きいて、[wb]にセットします。
読取専用でなくてもよいのですが、そうしたほうが共用ブックでほかの人が開いていたりしてもエラーにならないのでお勧めです。
また、TANAKA先生と神髄先生の記事を置いておきます。
Office TANAKA ブックを開く
Excelの神髄 第63回ブックを開く（Open,Add）
wb.Close False
[wb]を保存しないで閉じます。
保存して閉じる場合は
wb.Close True
です。
filename = Dir()
次のファイル名を取得します。()内のファイルパスは省略できます。
row_出力 = row_出力 + 1
出力シートの出力行を一つ下にずらします。
これを忘れると永遠に2行目に出力されます。
さて、Loopの中に行きましょう。
'対象シートをセット
Set ws = wb.Worksheets(1)開いた[wb]の1シート目を[ws]にセットします。（１シート目に情報があるという前提です）
'基本情報シート読取り行番号に開始行を代入
row_基本情報 = row_基本情報_開始行基本情報シートの開始行（6行目）を[row_基本情報]に入れます。
'出力シート出力列に開始列を代入
col_出力 = 1こんどは、出力シートの出力列[col_出力]に1を入れます。
これらはループの都度にリセット(最初の値に戻す)される変数です。
Do Until ws_基本情報.Range("C" & row_基本情報).Value = ""
'元データシートの情報→出力シートに出力
ws_出力.Cells(row_出力, col_出力).Value = ws.Range(ws_基本情報.Range("C" & row_基本情報).Value).Value
'基本情報シート：次の行へ
row_基本情報 = row_基本情報 + 1
'出力シート：次の列へ
col_出力 = col_出力 + 1
Loop最初のLOOPの内側のLOOP処理です。
基本情報シートの「セル位置」が入力されているC列を開始行から最後の行まで繰り返し処理します。最後の行かどうかはC列に文字が入力されているかどうかで判定します。
Do Until ws_基本情報.Range(“C” & row_基本情報).Value = “”
・・・
Loop
Do Untile を書いたら最後の Loop を先に書くといいですね。
基本情報シートと出力シート、コピー元のファイルのシートとシートを行き来するのでワークシート名はしっかり指定しましょう。
ws_出力.Cells(row_出力, col_出力).Value = ws.Range(ws_基本情報.Range(“C” & row_基本情報).Value).Value
ここ、わかりにくいですね。
左辺は出力シートのセルです。右辺は元データシートのセルです。右辺の元データシートのセルを指定するために基本情報シートのセルの情報を使用しています。
実際には下図のような指定になります。
ws_出力.Cells(2,1).Value = ws.Range(“H1”).Value
コピー元ファイルの値をコピーして貼り付けしてもよいのですが、上記のようにイコールとすることで右辺のセルの値を左辺のセルの値にインプットすることができます。
CellsとRangeは同様にシートのセルを指定できます。
指定の方法は
Cells(行番号,列番号)
Range(“A1”)
のように指定します。
長くなるので、神髄先生の解説を貼っておきます、
Excelの神髄 第11回RangeとCellsの使い方
Excelの神髄 第9回Rangeでのセルの指定方法
下のように分解して一つずつ順を追って書くこともできます。
ws_出力.Cells(row_出力, col_出力).Value = ws.Range(ws_基本情報.Range(“C” & row_基本情報).Value).Value
↓
Dim 読取セル位置 As String, buf As Variant
読取セル位置 = ws_基本情報.Range(“C” & row_基本情報).Value
buf = ws.Range(読取セル位置).Value
ws_出力.Cells(row_出力, col_出力).Value = buf
次に、基本情報シートの読取セルを一つ下へ、出力シートの出力列を一つ右にずらすために変数の値を一つ増やします。
‘基本情報シート：次の行へ
row_基本情報 = row_基本情報 + 1
‘出力シート：次の列へ
col_出力 = col_出力 + 1
これでループ部分は終了です。
最後に書いても書かなくてもよいのですが、出力シートを前面に出す、終わったよメッセージをだす、というコードを書きます。
'出力シートをアクティブに
ws_出力.Activate
'終了メッセージ表示
MsgBox "出力完了"マクロ終了後にデータを書き出しした出力シートを見たいだろうなーという気遣い、と、マクロが終わったことがわからないと不便だろうなーという気遣いです。
余談ですが、「きっとこうなると利用者はうれしいだろうな」という気遣いが、「次もあの人に頼もう」という信頼に繋がるかなと思っており、各種気遣いを一生懸命考えます。「こうすると便利」「ここは気を付ける点」等というポイントに気が付けるかは、これまでエクセル作業者側で長くやってきた経験が役立っているように思います。
ま、それよりもマクロの出力結果が正確であることが何よりも大事ですので、そこもしっかりやります。
（４）コード全文
コメントには書いていないのですが、最初に画面更新を止めるコード、最後に画面更新を止めるをやめるコードを書いておくと、処理が高速化するとかしないとか。なので、最初と最後に Application.ScreenUpdating を入れています。
Office TANAKA 画面を止める
Sub フォルダ下のファイル情報取得()
'画面更新ストップ
Application.ScreenUpdating = False
'出力シート、基本情報シートをセット
Dim ws_出力 As Worksheet, ws_基本情報 As Worksheet
Set ws_出力 = Worksheets("出力")
Set ws_基本情報 = Worksheets("基本情報")
'基本情報シートからターゲットフォルダパスを変数path_フォルダに代入
Dim path_フォルダ As String
path_フォルダ = ws_基本情報.Range("D2").Value & "\"
'Loop内で使用する変数
Dim filename As String
Dim wb As Workbook
Dim ws As Worksheet
Dim row_基本情報 As Long
Dim row_出力 As Long
Dim col_出力 As Long
'基本情報シートセル位置開始行をセット
Const row_基本情報_開始行 As Long = 6
'ファイル名を取得し変数filenameに代入
filename = Dir(path_フォルダ & "*.xlsx")
'出力シート出力開始行を代入
row_出力 = 2
'LOOP開始:filenameが空になるまで
Do Until filename = ""
'ファイルを読取専用で開く
Set wb = Workbooks.Open(filename:=path_フォルダ & filename, ReadOnly:=True)
'対象シートをセット
Set ws = wb.Worksheets(1)
'基本情報シートのセル位置を開始行から最終行までループ
'基本情報シート読取り行番号に開始行を代入
row_基本情報 = row_基本情報_開始行
'出力シート出力列に開始列を代入
col_出力 = 1
Do Until ws_基本情報.Range("C" & row_基本情報).Value = ""
'元データシートの情報→出力シートに出力
ws_出力.Cells(row_出力, col_出力).Value = ws.Range(ws_基本情報.Range("C" & row_基本情報).Value).Value
'基本情報シート：次の行へ
row_基本情報 = row_基本情報 + 1
'出力シート：次の列へ
col_出力 = col_出力 + 1
Loop
'ファイルを保存せずに閉じる
wb.Close False
'次のファイルを取得
filename = Dir()
'出力シート出力開始行をカウントアップ
row_出力 = row_出力 + 1
Loop
'出力シートをアクティブに
ws_出力.Activate
'終了メッセージ表示
MsgBox "出力完了"
'画面更新ストップを解除
Application.ScreenUpdating = True
End Sub（５）取得セルをコード内で指定する場合のコード
取得セルをシートで指定するのではなく、直接コード内で指定する場合は、コードがシンプルになります。外側の１つのループだけで済むようになるからです。参考までにコードを載せておきます。
Sub フォルダ下のファイル情報取得_直接指定()
'画面更新ストップ
Application.ScreenUpdating = False
'出力シート、基本情報シートをセット
Dim ws_出力 As Worksheet, ws_基本情報 As Worksheet
Set ws_出力 = Worksheets("出力")
Set ws_基本情報 = Worksheets("基本情報")
'基本情報シートからターゲットフォルダパスを変数path_フォルダに代入
Dim path_フォルダ As String
path_フォルダ = ws_基本情報.Range("D2").Value & "\"
'Loop内で使用する変数
Dim filename As String
Dim wb As Workbook
Dim ws As Worksheet
Dim row_出力 As Long
'ファイル名を取得し変数filenameに代入
filename = Dir(path_フォルダ & "*.xlsx")
'出力シート出力開始行を代入
row_出力 = 2
'LOOP開始:filenameが空になるまで
Do Until filename = ""
'ファイルを読取専用で開く
Set wb = Workbooks.Open(filename:=path_フォルダ & filename, ReadOnly:=True)
'対象シートをセット
Set ws = wb.Worksheets(1)
'コピー元wsの値を出力シートに出力
ws_出力.Cells(row_出力, 1).Value = ws.Range("H1").Value
ws_出力.Cells(row_出力, 2).Value = ws.Range("C3").Value
ws_出力.Cells(row_出力, 3).Value = ws.Range("C5").Value
ws_出力.Cells(row_出力, 4).Value = ws.Range("F5").Value
ws_出力.Cells(row_出力, 5).Value = ws.Range("C6").Value
'ファイルを保存せずに閉じる
wb.Close False
'次のファイルを取得
filename = Dir()
'出力シート出力開始行をカウントアップ
row_出力 = row_出力 + 1
Loop
'出力シートをアクティブに
ws_出力.Activate
'終了メッセージ表示
MsgBox "出力完了"
'画面更新ストップを解除
Application.ScreenUpdating = True
End Sub４．最後に
いかがでしたでしょうか。VBAのコードの書き方に「これが正解！」はありませんので、あくまで一例のやり方です。
いつもはこのような書き方はしません。入力・出力を別のカタマリとしたい派なので、配列を使います。気が向いたら続編でそれも書くかもしれません。
お付き合いいただきありがとうございました。
５.参考文献・記事
内部リンク やってみよう！VBAシリーズ
【Excel/VBA】わたしがVBAをがっちり習得した方法
【Excel/VBA】やってみよう！VBA①
【Excel/VBA】やってみよう！VBA！②
【Excel/VBA】やってみよう！VBA！③
【Excel/VBA】やってみよう！VBA！④
【Excel/VBA】やってみよう！VBA⑤ワークシートの操作
【Excel/VBA】やってみよう！VBA⑥ファイルの操作
【Excel/VBA】やってみよう！VBA！⑦ファイルの操作その２
【Excel/VBA】やってみよう！VBA⑧最後に
お勧めの書籍
初心者向け
高橋宣成先生の ChatGPTで身につけるExcel VBA もでます！
中級者向け
上級者向け
コメント