ExcelVBA練習問題シリーズ#2「注文書をデータ取込」マクロ②解答コードです。
もちろんこれが正解という訳ではなく、いろいろなやり方あると思いますが、
ひとつの解答としてご参考ください。
※ 挑戦ポイントには対応していない基本コードになります。
◇ 出題ページはこちら
www.limecode.jp
◇ 解答ページはこちら
VBA問題#2「注文書をデータ取込」マクロ①解答
VBA問題#2「注文書をデータ取込」マクロ②解答【本ページ】
VBA問題#2「注文書をデータ取込」完成版解答(挑戦ポイント制覇)
ソースコード
Option Explicit ' マクロ② 指定フォルダ内の全注文書を取込 Sub 指定フォルダ内にあるすべての注文書ファイルを販売データに取り込む() ' 取込ログをクリア WS実行シート.Range(WS実行シート.Rows(12), WS実行シート.Rows(WS実行シート.UsedRange.Rows.Count)).Value = "" ' 取込フォルダの存在チェック Dim Path取込フォルダ As String: Path取込フォルダ = WS実行シート.Range("C9") If Dir(Path取込フォルダ, vbDirectory) = "" Then MsgBox "指定したフォルダが存在しません。": Exit Sub ' ファイルの存在チェック Dim dirファイル名 As String: dirファイル名 = Dir(Path取込フォルダ & "\*.xlsx") If dirファイル名 = "" Then MsgBox "指定フォルダ内にxlsxファイルがひとつもありません。": Exit Sub ' 出力第1行(最終行+1)と出力No(最大値+1)を取得 Dim R_第1出力行 As Long: R_第1出力行 = WS販売データ.UsedRange.Rows.Count + WS販売データ.UsedRange.Row - 1 + 1 Dim R_出力 As Long: R_出力 = R_第1出力行 Dim 出力No As Long: 出力No = WorksheetFunction.Max(WS販売データ.Columns(2)) + 1 ' フォルダ内のすべてのxlsxファイルを取得 Dim 取込ファイルNo As Long: 取込ファイルNo = 1 Dim R_ログ As Long: R_ログ = 12 Do While dirファイル名 <> "" ' 注文書シートの取得 Dim wb取込ファイル As Workbook: Set wb取込ファイル = Nothing Dim ws注文書 As Worksheet: Set ws注文書 = Nothing On Error Resume Next ' ファイルを開いていなければ開く Set wb取込ファイル = Workbooks(dirファイル名) ' ← 開いていなければエラーでスキップ If wb取込ファイル Is Nothing Then ' ↑がスキップされていればファイルを開く Set wb取込ファイル = Workbooks.Open(Path取込フォルダ & "\" & dirファイル名) End If Set ws注文書 = wb取込ファイル.Worksheets("注文書") On Error GoTo 0 ' 注文書シートが取得できた場合はメインコードへ If Not ws注文書 Is Nothing Then ' 対象年度の注文書ファイルを処理 Dim 注文書年度 As Long: 注文書年度 = Year(ws注文書.Range("C7")) If Month(ws注文書.Range("C7")) <= 3 Then 注文書年度 = 注文書年度 - 1 If WS販売データ.Range("F2") = 注文書年度 Then ' 注文書の表部分をループ Dim R_取込 As Long For R_取込 = 12 To 21 ' 金額が0でない行を取込 If ws注文書.Cells(R_取込, 6) <> 0 Then WS販売データ.Cells(R_出力, 2) = 出力No ' No WS販売データ.Cells(R_出力, 3) = ws注文書.Range("C5") ' 購入者 WS販売データ.Cells(R_出力, 4) = Month(ws注文書.Range("C7")) ' 月 WS販売データ.Cells(R_出力, 5) = Day(ws注文書.Range("C7")) ' 日 WS販売データ.Cells(R_出力, 6) = ws注文書.Cells(R_取込, 3) ' 品物 WS販売データ.Cells(R_出力, 7) = ws注文書.Cells(R_取込, 4) ' 価格 WS販売データ.Cells(R_出力, 8) = ws注文書.Cells(R_取込, 5) ' 個数 WS販売データ.Cells(R_出力, 9) = ws注文書.Cells(R_取込, 6) ' 売上 WS販売データ.Cells(R_出力, 10) = Date ' 取込日 ' 出力行とNoを更新 R_出力 = R_出力 + 1 出力No = 出力No + 1 End If Next ' 注文書の表部分をループ ' ファイルをログに記録 WS実行シート.Cells(R_ログ, 2) = 取込ファイルNo WS実行シート.Cells(R_ログ, 3) = wb取込ファイル.Name WS実行シート.Cells(R_ログ, 4) = "取込完了" 取込ファイルNo = 取込ファイルNo + 1 R_ログ = R_ログ + 1 End If End If ' ファイルを開いていたら閉じる If Not wb取込ファイル Is Nothing Then wb取込ファイル.Close False ' 次のファイルへ dirファイル名 = Dir() Loop WS販売データ.Activate WS販売データ.Range(WS販売データ.Rows(R_第1出力行) _ , WS販売データ.Rows(R_出力 - 1)).Select MsgBox "データの取込を完了しました。" End Sub ' フォルダのダイアログ選択 Sub フォルダを選択する() WS実行シート.Range("C9") = GetPathダイアログボックスでフォルダを選択する(ThisWorkbook.Path) End Sub Function GetPathダイアログボックスでフォルダを選択する(Optional Path初期表示フォルダ As String = "") As String With Application.FileDialog(msoFileDialogFolderPicker) If Path初期表示フォルダ <> "" Then .InitialFileName = Path初期表示フォルダ If .Show Then: GetPathダイアログボックスでフォルダを選択する = .SelectedItems(1) End With End Function
解説
各コードの解説と工夫しているポイントは以下の通りです。
全体を通して
多数のブックに加えて自ブック内の複数シートも同時に扱うマクロなので、
各ブック・シートの指定をしっかり行うのが重要になります。
Cells、Rangeの親を省略してActiveSheetやActiveWorkbookに実行するのは、
思わぬ事故を呼びますから避けましょう。
今回のような複数ブックを指定するマクロでは、wb取込ファイル、ws注文書など、
対象を変数にしっかり入れることでコードが整理されます。
また自ブックのシートは「シートオブジェクト名」を用いることで、
特に宣言なくWS販売データ、WS実行シートという指定ができるようになります。
これらをしっかり準備しておけば、実際のコードを書く際は
こんな風に選択肢から入力ができるようになります。
（選択肢表示のショートカットキーはCtrl+Space）
ここまで準備しておけばメインコードがだいぶ書きやすくなりますね。
今回のように多数のシートを並行して扱うマクロを書くときは、
「自分の頭を整理しやすいコード」が大事になります。
変数の整理は丁寧にやっておきましょう。
フォルダ内のすべてのファイルを開いていく部分
今回のメインテーマである「フォルダ内の全ファイルを走査」するコードは、
Dir関数を用いた基本的なコードになっています。
Dim dirファイル名 As String: dirファイル名 = Dir(Path取込フォルダ & "\*.xlsx") If dirファイル名 = "" Then MsgBox "指定フォルダ内にxlsxファイルがひとつもありません。": Exit Sub Do While dirファイル名 <> "" ' ここに各ファイルに対する処理 dirファイル名 = Dir() Loop
構造自体は単純なのですが、この手のコードの問題は、
中見のコードが長大になるため全体像を見渡すのが大変になるという点です。
この問題を根本的に解決するためには「Subプロシージャの分割」が必要なので、
こういった長大なループ処理が増えてきたらぜひ挑戦してみましょう。
プロシージャ分割コードのイメージはこちら↓
Dim dirファイル名 As String: dirファイル名 = Dir(Path取込フォルダ & "\*.xlsx") If dirファイル名 = "" Then MsgBox "指定フォルダ内にxlsxファイルがひとつもありません。": Exit Sub Do While dirファイル名 <> "" Dim wb取込ファイル As Workbook Set wb取込ファイル = ファイルを開いていなければ開く(Path取込フォルダ, dirファイル名) Call 指定の注文書を販売データに取り込む(wb取込ファイル) If Not wb取込ファイル Is Nothing Then wb取込ファイル.Close False dirファイル名 = Dir() Loop
ここまでくるとループ全体が見渡せるようになりますし、
データを取り込むメインコードも同じようにスッキリ書くことができます。
本課題の完成版解答でプロシージャ分割を行ったコードが見れますので、
すぐには挑戦せずとも、一度見ておくとイメージが付きやすいかもしれません。
流し読みでもよいので、分割コードも眺めてみてください。
VBA問題#2「注文書をデータ取込」解答(挑戦ポイント完成版)【準備中】
On Error Resume Nextの活用
さてプロシージャ分割は一旦置いておき、
今回のようなファイル操作コードを書くときのテクニックをいくつか紹介します。
まず今回のような「存在チェックを複数回実行する処理」では、
On Error Resume Nextによる判定がとても便利です。
ファイルが存在し、Excelで開くことができ、対象シートがあるかどうかを、
- Set Workbooks(○○) としてみて、エラーならブックを開いていない
- Workbooks.Open(○○)としてみて、エラーなら開くのに失敗している
- Worksheets(○○)としてみて、エラーならシートが存在しない
こんな風にまとめてやってしまうことができます。
この方法のいいところは、上記のチェックをすべて突破できたかどうかの判定が、
「最終的に目的オブジェクトがNothingになっていないかどうか」一発で済む点です。
If Not ws注文書 Is Nothing Then
書きやすくて読みやすいいいコードですよね。
ついでですが、「On Error Resume Next」から「On Error GoTo 0」までを、
IF文やFor文のようにブロックとしてインデントするのも読みやすくておすすめです。
On Error Resume Next ' ファイルを開いていなければ開く Set wb取込ファイル = Workbooks(dirファイル名) ' ← 開いていなければエラーでスキップ If wb取込ファイル Is Nothing Then ' ↑がスキップされていればファイルを開く Set wb取込ファイル = Workbooks.Open(Path取込フォルダ & "\" & dirファイル名) End If Set ws注文書 = wb取込ファイル.Worksheets("注文書") On Error GoTo 0
こうすることで「エラースキップ活用コード」の範囲を明示できますので、
気に入ったら採用してみてください。
ループ内で使用する変数は必ず初期化すること
今回のようなコードで高頻度で不具合を発生させる罠として、
「各ループごとに使う変数の初期化忘れ」が挙げられます。
' フォルダ内のすべてのxlsxファイルを取得 Do While dirファイル名 <> "" ' 注文書シートの取得 Dim wb取込ファイル As Workbook: Set wb取込ファイル = Nothing Dim ws注文書 As Worksheet: Set ws注文書 = Nothing ' ↑ このSet = Nothing を書き忘れると事故が起きる
この初期化コードを書き忘れると、例えば次のファイルが対象外ファイルだった際、
- SetコードがOn Error Resume Nextによってスキップされる
- 結果的にひとつ前のブックやシートがSetされたまま次のコードへ
- そのファイルはもう閉じているので「オートメーションエラー」が発生
といった不具合が発生します。
感覚的には「ループごとに一から処理を繰り返す」ように感じますが、
システム的には前の値が入ったままならそれが次のループで使用されてしまいます。
この初期化は絶対に忘れないようにしておきましょう。
ついでですが、原因を調べづらい「オートメーションエラー」は、
閉じてしまったブックのシートやセルを指定することでも発生します。
オートメーションエラーの体感7～8割はこの原因な気がしますね。
知っておくと発生時に慌てなくて済むかもしれませんので、
心の片隅にでも置いておいてください。
カウンタ変数をしっかり命名する
今回のマクロは「取込ログ」も作成する必要があるため、
販売データ、注文書、ログの3つの行番号が必要になります。
これをi , j , k でやると普通に死ねますのでやめましょう笑
今回のコードのように「行番号の変数名をR_○○」としておけば、
この選択肢を「R + Ctrl+Space」で表示させることができます。
これなら取り違えも起きづらいですし、
配列などでiを使ったコードがあっても問題なくコピペできます。
カウンタ変数を何のカウンタかわかるように命名するのは、
地味ですが大事なポイントなので押さえておいてください。
www.limecode.jp
フォルダのダイアログ選択
フォルダのダイアログ選択ですが、こちらの記事のコードをそのまま使いました。
www.limecode.jp
' フォルダのダイアログ選択 Sub フォルダを選択する() WS実行シート.Range("C9") = GetPathダイアログボックスでフォルダを選択する(ThisWorkbook.Path) End Sub Function GetPathダイアログボックスでフォルダを選択する(Optional Path初期表示フォルダ As String = "") As String With Application.FileDialog(msoFileDialogFolderPicker) If Path初期表示フォルダ <> "" Then .InitialFileName = Path初期表示フォルダ If .Show Then: GetPathダイアログボックスでフォルダを選択する = .SelectedItems(1) End With End Function
ネットにあるコードの中には、最初からFunctionにしてくれているものもあり、
そういったコードをそのまま使うのもいい手だと思います。
今回の処理なんてその関数のCall1行で終わっていますしね。
関数化されているコードは、引数と返り値の仕様さえわかっていれば、
中身がわからないまま使ってもメンテナンス性を損ないません。
ちょっと特殊な処理をするコードは、こんな実装方法もアリだと思います。
以上でマクロ②の解説を終わります。
基本コードの詰め合わせでしたが、
読みやすく書こうとすると、工夫できるポイントがたくさんありましたね。
マクロ②の作成が完了したら、是非挑戦ポイント完成版の解説も読んでみてください。
このコードを改良するにはどんな方法があるかを知る意味で、
コードを眺めてみるだけでも勉強になると思います。
