Excel・VBA総合コミュニティ「Excel-Fun.xls*」にて毎月出題される、
VBAの問題に対する私の回答ソースコードを掲載いたします。
今回掲載するコードは本ブログのVBA問題集#3としても出題していた、
「月次請求書を作成」問題です。
今回は回答を以下の2パターン作成しました。
- 読みやすさ重視でVBAの王道なループ処理を行ったバージョン
- コーディング効率重視で開発コストを落とす手法を用いたバージョン
1の王道バージョンは下記ページで詳細を解説しましたのでこちらをご覧ください。
www.limecode.jp
本ページでは2の「低コスト開発バージョン」を解説します。
課題の内容
今回は請求書の月次作成業務全体を自動化する総合問題です。
詳細は下記リンク内にある「課題説明」シートをご確認ください。
せっかくなので回答を見る前に皆さんも挑戦してみましょう。
一度自分が作ってから他の人のコードを見ることで、
学習効果が何倍にも高まります。
完成させなくても、出来る範囲で解くだけでも十分効果がありますので、
是非ともトライしてみてください!
◇ 「領収書PDFを出力」の課題ファイルはこちら
Discord:★出題【VBA】#007 月次請求書を作成
◇ 「領収書PDFを出力」への回答集はこちら
Discord:☆回答【VBA】#007 月次請求書を作成
※上記はDiscord参加済みの方用のURLです
未参加の方は下記からご参加ください!
www.limecode.jp
課題の回答ファイル
実際の回答ファイルはこちらをご覧ください。
(和風スパ)【VBA】007_月次請求書を作成.xlsm
月次請求書ファイルテンプレート.xlsx
※ 実行時は上記の2ファイルを同じフォルダに保存してください。
ソースコード
標準モジュール:Df_シートレイアウト
Option Explicit ' 販売データ Public Const Adrs販売データ_年度 = "H2" Public Const R1st販売データ = 5 Public Const C1st販売データ = 2 Public Enum CNo販売データ No = C1st販売データ 取引先コード 取引先名 月 日 商品コード 品物 価格 個数 売上 End Enum Public Const CLast販売データ = CNo販売データ.売上 ' 月次請求書テンプレートファイル Public Const BkName月次請求書テンプレート = "月次請求書ファイルテンプレート.xlsx" ' 対象データ Public Const ShName対象データ = "対象データ" Public Const R1st対象データ = 2 Public Const C1st対象データ = 1 Public Enum CNo対象データ No = C1st対象データ 取引先コード 取引先名 購入日 商品コード 品物 種別 価格 個数 売上 End Enum Public Const CLast対象データ = CNo対象データ.売上 ' 請求書 Public Const ShName請求書 = "請求書" Public Const Adrs請求書_発行日 = "H2" Public Const Adrs請求書_取引先名 = "B6" Public Const Adrs請求書_件名 = "B8" Public Const Adrs請求書_ご請求金額 = "D11" Public Const Adrs請求書_お支払い期限 = "D13" Public Const Adrs請求書_合計税別 = "I21" Public Const Adrs請求書_消費税 = "I22" Public Const Adrs請求書_合計税込 = "I23" Public Const Adrs請求書_摘要 = "B26" Public Const R1st請求書 = 16 Public Const RLast請求書 = 20 Public Const RCount請求書 = RLast請求書 - R1st請求書 + 1 Public Const C1st請求書 = 2 Public Enum CNo請求書 No = C1st請求書 種別 = 3 件数 = 7 金額 = 9 End Enum Public Const CLast請求書 = CNo請求書.金額 ' 請求明細書 Public Const ShName請求明細書 = "請求明細書" Public Const Adrs請求明細書_取引先名 = "B5" Public Const Adrs請求明細書_発行日 = "J5" Public Const Adrs請求明細書_ページNo = "B32" Public Const Adrs請求明細書_合計税別 = "K28" Public Const Adrs請求明細書_消費税 = "K29" Public Const Adrs請求明細書_合計税込 = "K30" Public Const Adrs請求明細書_2ページ目以降非表示行 = "28:30" Public Const R1st請求明細書 = 8 Public Const RLast請求明細書 = 127 Public Const RCount請求明細書 = 20 Public Const C1st請求明細書 = 2 Public Enum CNo請求明細書 No = C1st請求明細書 ご購入日 = 3 商品 = 5 単価 = 8 数量 = 10 金額 = 11 End Enum Public Const CLast請求明細書 = CNo請求明細書.金額 ' 実行シート Public Const Adrs単独実行_取引先コード = "C2" Public Const Adrs単独実行_取引先名 = "C3" Public Const Adrs単独実行_対象年 = "C4" Public Const Adrs単独実行_対象月 = "C5" Public Const Adrs一括実行_請求日 = "C8" Public Const Adrs一括実行_対象年 = "C9" Public Const Adrs一括実行_対象月 = "C10" Public Const Adrs一括実行_対象締日 = "C11" ' 取引先マスタ Public Const R1st取引先マスタ = 2 Public Const C1st取引先マスタ = 1 Public Enum CNo取引先マスタ 取引先コード = C1st取引先マスタ 取引先名 締日 支払日 明細書 CSV End Enum Public Const CLast取引先マスタ = CNo取引先マスタ.CSV ' 商品マスタ ※1 Enum非対応数式注意 Public Const R1st商品マスタ = 2 Public Const C1st商品マスタ = 1 Public Enum CNo商品マスタ 商品コード = C1st商品マスタ 商品名 種別 価格 End Enum Public Const CLast商品マスタ = CNo商品マスタ.価格 ' 販売データ Function GetDate販売データ_購入日(R As Long) GetDate販売データ_購入日 = DateSerial年度版( _ WS販売データ.Range(Adrs販売データ_年度), _ WS販売データ.Cells(R, CNo販売データ.月), _ WS販売データ.Cells(R, CNo販売データ.日)) End Function
標準モジュール:Pr0_月次請求書作成_共通コード
Option Explicit ' 対象データ抽出シートの作成 ' 販売データのうち出力の対象となるデータだけに絞ったシートをまずは作成する ' 元データにない「種別」「販売日」の情報もここで追加する Sub 販売データから出力対象データを抽出する(ws対象データ As Worksheet _ , 対象取引先コード As Long, 開始日 As Date, 終了日 As Date) ' 対象データを抽出 Dim R_対象データ As Long: R_対象データ = R1st対象データ Dim R_販売データ As Long For R_販売データ = R1st販売データ To Get最終行(WS販売データ) Dim 購入日 As Date: 購入日 = GetDate販売データ_購入日(R_販売データ) If WS販売データ.Cells(R_販売データ, CNo販売データ.取引先コード) = 対象取引先コード _ And 開始日 <= 購入日 And 購入日 <= 終了日 Then ws対象データ.Cells(R_対象データ, CNo対象データ.No) = R_対象データ - R1st対象データ + 1 ws対象データ.Cells(R_対象データ, CNo対象データ.取引先コード) = WS販売データ.Cells(R_販売データ, CNo販売データ.取引先コード) ws対象データ.Cells(R_対象データ, CNo対象データ.取引先名) = WS販売データ.Cells(R_販売データ, CNo販売データ.取引先名) ws対象データ.Cells(R_対象データ, CNo対象データ.購入日) = 購入日 ws対象データ.Cells(R_対象データ, CNo対象データ.商品コード) = WS販売データ.Cells(R_販売データ, CNo販売データ.商品コード) ws対象データ.Cells(R_対象データ, CNo対象データ.品物) = WS販売データ.Cells(R_販売データ, CNo販売データ.品物) ws対象データ.Cells(R_対象データ, CNo対象データ.種別) = WorksheetFunction.VLookup _ (ws対象データ.Cells(R_対象データ, CNo対象データ.商品コード), WS商品マスタ.Columns("A:C"), 3, False) ' ※1 ws対象データ.Cells(R_対象データ, CNo対象データ.価格) = WS販売データ.Cells(R_販売データ, CNo販売データ.価格) ws対象データ.Cells(R_対象データ, CNo対象データ.個数) = WS販売データ.Cells(R_販売データ, CNo販売データ.個数) ws対象データ.Cells(R_対象データ, CNo対象データ.売上) = WS販売データ.Cells(R_販売データ, CNo販売データ.売上) R_対象データ = R_対象データ + 1 End If Next ' データが0件ならブックを保存せず閉じる If R_対象データ = R1st対象データ Then ws対象データ.Parent.Close False Set ws対象データ = Nothing End If End Sub ' 対象データ → 請求書 Sub 指定の対象データから請求書を出力する(wb出力ブック As Workbook _ , 開始日 As Date, 終了日 As Date, 対象年 As Long, 対象月 As Long, 発行日 As Date, 支払日設定 As String) ' テンプレートブック内のシートを取得 Dim ws対象データ As Worksheet: Set ws対象データ = wb出力ブック.Worksheets(ShName対象データ) Dim ws請求書 As Worksheet: Set ws請求書 = wb出力ブック.Worksheets(ShName請求書) ' 各定数の入力 ws請求書.Range(Adrs請求書_発行日) = Date ws請求書.Range(Adrs請求書_取引先名) = ws対象データ.Cells(R1st対象データ, CNo対象データ.取引先名) ws請求書.Range(Adrs請求書_件名) = "件名:" & 対象年 & "年" & 対象月 & "月分について" ws請求書.Range(Adrs請求書_摘要) = "対象取引期間:" & Format(開始日, "yyyy/m/d") _ & "~" & Format(終了日, "yyyy/m/d") Select Case 支払日設定 Case "翌月": ws請求書.Range(Adrs請求書_お支払い期限) = DateSerial(対象年, 対象月 + 2, 1) - 1 Case "翌々月": ws請求書.Range(Adrs請求書_お支払い期限) = DateSerial(対象年, 対象月 + 3, 1) - 1 End Select End Sub ' 対象データ → 請求明細書 Sub 指定の対象データから請求明細書を出力する(wb出力ブック As Workbook) ' テンプレートブック内のシートを取得 Dim ws対象データ As Worksheet: Set ws対象データ = wb出力ブック.Worksheets(ShName対象データ) Dim ws請求明細書 As Worksheet: Set ws請求明細書 = wb出力ブック.Worksheets(ShName請求明細書) ' 余り行を非表示 Dim データ数 As Long: データ数 = Get最終行(ws対象データ) - R1st対象データ + 1 ws請求明細書.Range(ws請求明細書.Rows(R1st請求明細書 + データ数) _ , ws請求明細書.Rows(RLast請求明細書)).Hidden = True End Sub ' 対象データ → CSVファイル Sub 指定の対象データシートをCSVファイルとして出力する(ws対象データ As Worksheet, 対象年 As Long, 対象月 As Long, path出力フォルダ As String) Dim 出力CSVファイル名 As String 出力CSVファイル名 = "請求データ" & 対象年 & "年" & 対象月 & "月" _ & "(" & ws対象データ.Cells(R1st対象データ, CNo対象データ.取引先名) & ").csv" ws対象データ.Copy Dim wb出力CSV As Workbook: Set wb出力CSV = ActiveWorkbook Application.DisplayAlerts = False wb出力CSV.SaveAs path出力フォルダ & "\" & 出力CSVファイル名, xlCSV Application.DisplayAlerts = True wb出力CSV.Close False End Sub ' 出力ブック → PDFファイル Sub 指定の対象データ同梱ブックをPDFファイルとして出力する(ws対象データ As Worksheet, 対象年 As Long, 対象月 As Long, path出力フォルダ As String) ' ファイル名を設定 Dim 出力ファイル名 As String 出力ファイル名 = "請求書" & 対象年 & "年" & 対象月 & "月" _ & "(" & ws対象データ.Cells(R1st対象データ, CNo対象データ.取引先名) & ").pdf" ' 対象データシートを非表示 ws対象データ.Visible = xlSheetHidden ' ブック全体をPDFに出力 ws対象データ.Parent.ExportAsFixedFormat xlTypePDF, path出力フォルダ & "\" & 出力ファイル名 End Sub
標準モジュール:Pr1_月次請求書作成_単独実行
Option Explicit ' マクロ① 月次請求書の単独出力 Sub 指定取引先コード対象月の月次請求書を出力する() ' 実行シートのパラメータを取得 Dim 対象取引先コード As Long: 対象取引先コード = WS実行シート.Range(Adrs単独実行_取引先コード) Dim 対象年 As Long: 対象年 = WS実行シート.Range(Adrs単独実行_対象年) Dim 対象月 As Long: 対象月 = WS実行シート.Range(Adrs単独実行_対象月) If 対象取引先コード = 0 Then MsgBox "取引先コードを指定してください。": Exit Sub If 対象年 = 0 Then MsgBox "対象年を指定してください。": Exit Sub If 対象月 = 0 Then MsgBox "対象月を指定してください。": Exit Sub ' 対象年が該当の年度でなければExit Dim 対象年度 As Long: 対象年度 = 対象年 - IIf(対象月 <= 3, 1, 0) If 対象年度 <> WS販売データ.Range(Adrs販売データ_年度) Then MsgBox "指定年月のデータはありません。": Exit Sub ' データの対象範囲を日付型として取得 Dim 開始日 As Date, 終了日 As Date 開始日 = DateSerial(対象年, 対象月, 1) 終了日 = DateSerial(対象年, 対象月 + 1, 1) - 1 ' テンプレートファイルを開く Dim wb出力ブック As Workbook Set wb出力ブック = Workbooks.Open(ThisWorkbook.Path & "\" & BkName月次請求書テンプレート, ReadOnly:=True) ' ■ 対象データを抽出 Dim ws対象データ As Worksheet: Set ws対象データ = wb出力ブック.Worksheets(ShName対象データ) Call 販売データから出力対象データを抽出する(ws対象データ, 対象取引先コード, 開始日, 終了日) If ws対象データ Is Nothing Then MsgBox "指定年月のデータはありません。": Exit Sub ' ■ 請求書シートの出力 Call 指定の対象データから請求書を出力する(wb出力ブック, 開始日, 終了日, 対象年, 対象月, Date, "翌月") ' ■ 請求明細書シートの出力 Call 指定の対象データから請求明細書を出力する(wb出力ブック) ' 出力フォルダの取得(作成) Dim path出力フォルダ As String: path出力フォルダ = ThisWorkbook.Path & "\請求書" If Dir(path出力フォルダ, vbDirectory) = "" Then MkDir path出力フォルダ ' ■ PDFファイルの出力 Call 指定の対象データ同梱ブックをPDFファイルとして出力する(ws対象データ, 対象年, 対象月, path出力フォルダ) ' 出力ブックを保存せず閉じる ws対象データ.Parent.Close False MsgBox "指定コードの請求書出力を完了しました。" End Sub
Pr2_月次請求書作成_一括実行
Option Explicit ' マクロ② 月次請求書の一括出力 Sub 対象締日対象年月の全取引先の月次請求書を一括出力する() ' 実行シートのパラメータを取得 Dim 請求日 As Date: 請求日 = WS実行シート.Range(Adrs一括実行_請求日) If 請求日 = 0 Then 請求日 = Date Dim 対象年 As Long: 対象年 = WS実行シート.Range(Adrs一括実行_対象年) Dim 対象月 As Long: 対象月 = WS実行シート.Range(Adrs一括実行_対象月) Dim 対象締日 As String: 対象締日 = WS実行シート.Range(Adrs一括実行_対象締日) If 対象年 = 0 Then MsgBox "対象年を指定してください。": Exit Sub If 対象月 = 0 Then MsgBox "対象月を指定してください。": Exit Sub If 対象締日 = "" Then MsgBox "対象締日を指定してください。": Exit Sub ' 別年度の指定はExit Dim 対象年度 As Long: 対象年度 = 対象年 - IIf(対象月 <= 3, 1, 0) If 対象年度 <> WS販売データ.Range(Adrs販売データ_年度) Then MsgBox "指定年月のデータはありません。": Exit Sub ' 締日から開始日と終了日を取得 Dim 開始日 As Date, 終了日 As Date If 対象締日 = "月末締め" Then 開始日 = DateSerial(対象年, 対象月, 1) 終了日 = DateSerial(対象年, 対象月 + 1, 1) - 1 Else Dim 締日 As Long: 締日 = Replace(対象締日, "日締め", "") 開始日 = DateSerial(対象年, 対象月 - 1, 締日 + 1) 終了日 = DateSerial(対象年, 対象月, 締日) End If ' 出力フォルダのチェックと作成 Dim path出力フォルダ As String: path出力フォルダ = ThisWorkbook.Path & "\請求書" & 対象年 & "年" & 対象月 & "月" & 対象締日 If Dir(path出力フォルダ, vbDirectory) = "" Then MkDir path出力フォルダ ' マスタをループして対象の取引先を検索 Dim R_取引先マスタ As Long Dim RLast取引先マスタ As Long: RLast取引先マスタ = Get最終行(WS取引先マスタ) For R_取引先マスタ = R1st取引先マスタ To RLast取引先マスタ ' 締日が合致した取引先を処理 If WS取引先マスタ.Cells(R_取引先マスタ, CNo取引先マスタ.締日) = 対象締日 Then ' 取引先マスタの情報を取得 Dim 対象取引先コード As Long: 対象取引先コード = WS取引先マスタ.Cells(R_取引先マスタ, CNo取引先マスタ.取引先コード) Dim 支払日設定 As String: 支払日設定 = WS取引先マスタ.Cells(R_取引先マスタ, CNo取引先マスタ.支払日) Dim is要明細 As Boolean: is要明細 = WS取引先マスタ.Cells(R_取引先マスタ, CNo取引先マスタ.明細書) <> "" Dim is要CSV As Boolean: is要CSV = WS取引先マスタ.Cells(R_取引先マスタ, CNo取引先マスタ.CSV) <> "" ' テンプレートファイルを開く Dim wb出力ブック As Workbook Set wb出力ブック = Workbooks.Open(ThisWorkbook.Path & "\" & BkName月次請求書テンプレート, ReadOnly:=True) ' ■ 対象データを抽出 Dim ws対象データ As Worksheet: Set ws対象データ = wb出力ブック.Worksheets(ShName対象データ) Call 販売データから出力対象データを抽出する(ws対象データ, 対象取引先コード, 開始日, 終了日) If ws対象データ Is Nothing Then GoTo 次の取引先へ ' ■ 請求書シートの出力 Call 指定の対象データから請求書を出力する(wb出力ブック, 開始日, 終了日, 対象年, 対象月, 請求日, 支払日設定) ' ■ 請求明細書シートの出力 If is要明細 Then Call 指定の対象データから請求明細書を出力する(wb出力ブック) Else wb出力ブック.Worksheets(ShName請求明細書).Visible = xlSheetHidden End If ' ■ CSVファイルの出力 If is要CSV Then: Call 指定の対象データシートをCSVファイルとして出力する(ws対象データ, 対象年, 対象月, path出力フォルダ) ' ■ PDFファイルの出力 Call 指定の対象データ同梱ブックをPDFファイルとして出力する(ws対象データ, 対象年, 対象月, path出力フォルダ) ' 出力ブックを保存せず閉じる ws対象データ.Parent.Close False 次の取引先へ: End If ' 締日が合致した取引先を処理 Next ' マスタをループして対象の取引先を検索 MsgBox "指定コードの請求書出力を完了しました。" End Sub
標準モジュール:Ut_汎用関数
Option Explicit ' 最終行の取得 Function Get最終行(指定シート As Worksheet, Optional 列番号 As Long = -1) As Long With 指定シート ' 列番号を省略時はシートの最終行 If 列番号 = -1 Then Get最終行 = .UsedRange.Rows.Count + .UsedRange.Row - 1 ' 列番号を指定時は列の最終行 Else Get最終行 = .Cells(.Rows.Count, 列番号).End(xlUp).Row End If End With End Function ' ブック最終シートの取得 Function Get最終シート(指定ブック As Workbook) As Worksheet Set Get最終シート = 指定ブック.Worksheets(指定ブック.Worksheets.Count) End Function ' 年度指定のDateSerial Function DateSerial年度版(ByVal 年度 As Long, ByVal m As Long, ByVal d As Long) As Date If m <= 3 Then DateSerial年度版 = DateSerial(年度 + 1, m, d) Else DateSerial年度版 = DateSerial(年度, m, d) End If End Function ' データ件数 Function Countデータ件数(対象シート As Worksheet) As Long If 対象シート.AutoFilterMode = False Then Exit Function With 対象シート.AutoFilter.Range Countデータ件数 = .Rows.Count + .Row - 2 End With End Function ' 各列のデータ部分 Function GetRange指定列のデータ部分(対象シート As Worksheet, 対象列 As Long) As Range If Countデータ件数(対象シート) = 0 Then Exit Function Set GetRange指定列のデータ部分 = 対象シート.Cells(対象シート.AutoFilter.Range.Row + 1, 対象列) _ .Resize(Countデータ件数(対象シート)) End Function ' WorksheetFunctionの短縮取得 Function Fx() As WorksheetFunction Set Fx = WorksheetFunction End Function
コードの解説
上記のコードは以下2パターンの回答のうち、「2の低コスト開発版」です。
- 読みやすさ重視でVBAの王道なループ処理を行ったバージョン
- コーディング効率重視で開発コストを落とす手法を用いたバージョン
1の王道バージョンは下記ページで詳細を解説しましたのでこちらをご覧ください。
www.limecode.jp
低コスト開発ということで、一番コードを変えているのが、
↓この「請求書」「請求明細書」の出力部分です。
' 対象データ → 請求書 Sub 指定の対象データから請求書を出力する(wb出力ブック As Workbook _ , 開始日 As Date, 終了日 As Date, 対象年 As Long, 対象月 As Long, 発行日 As Date, 支払日設定 As String) ' テンプレートブック内のシートを取得 Dim ws対象データ As Worksheet: Set ws対象データ = wb出力ブック.Worksheets(ShName対象データ) Dim ws請求書 As Worksheet: Set ws請求書 = wb出力ブック.Worksheets(ShName請求書) ' 各定数の入力 ws請求書.Range(Adrs請求書_発行日) = Date ws請求書.Range(Adrs請求書_取引先名) = ws対象データ.Cells(R1st対象データ, CNo対象データ.取引先名) ws請求書.Range(Adrs請求書_件名) = "件名:" & 対象年 & "年" & 対象月 & "月分について" ws請求書.Range(Adrs請求書_摘要) = "対象取引期間:" & Format(開始日, "yyyy/m/d") _ & "~" & Format(終了日, "yyyy/m/d") Select Case 支払日設定 Case "翌月": ws請求書.Range(Adrs請求書_お支払い期限) = DateSerial(対象年, 対象月 + 2, 1) - 1 Case "翌々月": ws請求書.Range(Adrs請求書_お支払い期限) = DateSerial(対象年, 対象月 + 3, 1) - 1 End Select End Sub ' 対象データ → 請求明細書 Sub 指定の対象データから請求明細書を出力する(wb出力ブック As Workbook) ' テンプレートブック内のシートを取得 Dim ws対象データ As Worksheet: Set ws対象データ = wb出力ブック.Worksheets(ShName対象データ) Dim ws請求明細書 As Worksheet: Set ws請求明細書 = wb出力ブック.Worksheets(ShName請求明細書) ' 余り行を非表示 Dim データ数 As Long: データ数 = Get最終行(ws対象データ) - R1st対象データ + 1 ws請求明細書.Range(ws請求明細書.Rows(R1st請求明細書 + データ数) _ , ws請求明細書.Rows(RLast請求明細書)).Hidden = True End Sub
1のコードと比べるとコード量が1/4以下になっています。
請求書は取引先名や摘要などの単独出力欄だけの処理になっており、
請求明細にいたっては行の非表示しか処理を行っていません。
なぜこれで出力が終わっているかというと、
処理のほとんどをシート関数にやらせているからです。
今回のコードはマクロファイル内にあった「請求書」「請求明細書」シートを、
外部のExcelファイルに移動して「テンプレートファイル」にしています。
そこに「対象データ」シートもつけてあげることで、
「対象データの抽出が終わると請求書/明細書の計算も終わっている」
仕様のテンプレートファイルにしました。
例えば今回の計算の肝となる請求書の「種別」ごとの計算は、
このように「UNIQUE、COUNTIF、SUMIF」のお馴染み3兄弟で計算しています。
このやり方は集計作業を半自動化させるときによく出てくる手法ですよね。
- 集計表の関数を完成させておく
- 元データを差し替えると集計が完了する
↑こんな風にExcel作業を効率化した経験はだれしもあると思います。
今回の記事で説明したように、この方法はマクロでも同じように実行ができます。
- 関数が入ったテンプレートファイルを用意しておく
- マクロ実行の度に読取専用で開いて使う
- テンプレート内のデータシートを更新するだけで処理の大部分が完了
この手法を知っておくと、出力帳票の形式によっては、
かなりのコード量を削減できることがあります。
特にスピルや新関数が使える365環境においては絶大な効果を発揮しますので、
ゴリゴリコードを書く方法とは別に、引き出しとして持っておいてください。