VBA問題#3「月次請求書を作成」マクロ②解答

ExcelVBA練習問題シリーズ#3「月次請求書を作成」マクロ②解答コードです。

今回は請求書の月次作成業務全体を自動化する総合問題です。

もちろんこれが正解という訳ではなく、いろいろなやり方あると思いますが、
ひとつの解答としてご参考ください。

※ 挑戦ポイントには対応していない基本コードになります。

◇ 出題ページはこちら
www.limecode.jp
◇ 解答ページはこちら
VBA問題#3「月次請求書を作成」マクロ①解答
VBA問題#3「月次請求書を作成」マクロ②解答【本ページ】
VBA問題#3「月次請求書を作成」解答完成版(挑戦ポイント制覇)
VBA問題#3「月次請求書を作成」別解(低コスト開発版)
　

解答ファイル

【VBA解答】#3「月次請求書を作成」マクロ②.xlsm

ソースコード

標準モジュール: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 R1st対象データ = 2
Public Const C1st対象データ = 1
Public Enum CNo対象データ
    No = C1st対象データ
    取引先コード
    取引先名
    購入日
    商品コード
    品物
    種別
    価格
    個数
    売上
End Enum
Public Const CLast対象データ = CNo対象データ.売上

' 請求書
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 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請求明細書 = 27
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商品マスタ.価格

標準モジュール:Pr1_月次請求書作成_単独実行

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取引先マスタ = WS取引先マスタ.UsedRange.Rows.Count - WS取引先マスタ.UsedRange.Row + 1
    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) <> ""


            ' 【対象データの抽出】
            ' 販売データのうち出力の対象となるデータだけに絞ったシートをまずは作成する
            ' 元データにない「種別」「販売日」の情報もここで追加する

            ' 対象データシートを新規出力
            TplWS対象データ.Copy
            Dim ws対象データ As Worksheet: Set ws対象データ = ActiveSheet
            Dim wb出力ブック As Workbook: Set wb出力ブック = ActiveWorkbook
    
            ' 対象データを抽出
            Dim R_対象データ As Long: R_対象データ = R1st対象データ
            Dim R_販売データ As Long
            Dim RLast販売データ As Long: RLast販売データ = WS販売データ.UsedRange.Rows.Count - WS販売データ.UsedRange.Row + 1
            For R_販売データ = R1st販売データ To RLast販売データ
                
                Dim 購入日 As Date
                購入日 = DateSerial(対象年, WS販売データ.Cells(R_販売データ, CNo販売データ.月) _
                                                         , WS販売データ.Cells(R_販売データ, CNo販売データ.日))
    
                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
    
            Dim RLast対象データ As Long: RLast対象データ = R_対象データ - 1
            Dim 対象データ数 As Long: 対象データ数 = RLast対象データ - R1st対象データ + 1
            
            If 対象データ数 = 0 Then GoTo 次の取引先へ
    
            ' 【請求書シートの出力】
            
            ' 請求書シートをテンプレートからコピーして作成
            TplWS請求書.Copy after:=ws対象データ
            Dim ws請求書 As Worksheet: Set ws請求書 = ActiveSheet
            
            ' 各定数の入力
            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
            
            ' 表部分の出力
            Dim 種別No As Long: 種別No = 1
            Dim range対象データ種別 As Range: Set range対象データ種別 = ws対象データ.Cells(R1st対象データ, CNo対象データ.種別).Resize(対象データ数)
            Dim range対象データ売上 As Range: Set range対象データ売上 = ws対象データ.Cells(R1st対象データ, CNo対象データ.売上).Resize(対象データ数)
            Dim range請求書種別 As Range: Set range請求書種別 = ws請求書.Cells(R1st請求書, CNo請求書.種別).Resize(RCount請求書)
            For R_対象データ = R1st対象データ To RLast対象データ
                
                Dim key種別 As String: key種別 = ws対象データ.Cells(R_対象データ, CNo対象データ.種別)
                
                ' 新しい種別が登場した際に出力
                On Error Resume Next
                Dim R_請求書 As Long: R_請求書 = 0
                R_請求書 = WorksheetFunction.Match(key種別, range請求書種別, 0)
                On Error GoTo 0
                
                ' 計算して出力
                If R_請求書 = 0 Then
                    R_請求書 = R1st請求書 + 種別No - 1
                    ws請求書.Cells(R_請求書, CNo請求書.No) = 種別No
                    ws請求書.Cells(R_請求書, CNo請求書.種別) = ws対象データ.Cells(R_対象データ, CNo対象データ.種別)
                    ws請求書.Cells(R_請求書, CNo請求書.件数) = WorksheetFunction.CountIf(range対象データ種別, key種別)
                    ws請求書.Cells(R_請求書, CNo請求書.金額) = WorksheetFunction.SumIf(range対象データ種別, key種別, range対象データ売上)
                    種別No = 種別No + 1
                End If
            
            Next
            
            ' 【請求明細シートの出力】
            If is要明細 Then
            
                ' 請求明細書シートをテンプレートからコピーして作成
                TplWS請求明細書.Copy after:=ws請求書
                Dim ws請求明細書 As Worksheet: Set ws請求明細書 = ActiveSheet
                
                ' 各定数の入力
                ws請求明細書.Range(Adrs請求明細書_発行日) = Date
                ws請求明細書.Range(Adrs請求明細書_取引先名) = ws対象データ.Cells(R1st対象データ, CNo対象データ.取引先名)
                ws請求明細書.Range(Adrs請求明細書_合計税別) = ws請求書.Range(Adrs請求書_合計税別)
                ws請求明細書.Range(Adrs請求明細書_消費税) = ws請求書.Range(Adrs請求書_消費税)
                ws請求明細書.Range(Adrs請求明細書_合計税込) = ws請求書.Range(Adrs請求書_合計税込)
                
                ' 表部分の出力
                Dim ページNo As Long: ページNo = 1
                Dim R_請求明細 As Long: R_請求明細 = R1st請求明細書
                For R_対象データ = R1st対象データ To RLast対象データ
                
                    ' 最終行を超えたら次ページへ
                    If R_請求明細 > RLast請求明細書 Then
                    
                        ページNo = ページNo + 1
                    
                        TplWS請求明細書.Copy after:=wb出力ブック.Worksheets(wb出力ブック.Worksheets.Count)
                        Set ws請求明細書 = ActiveSheet
                        ws請求明細書.Range(Adrs請求明細書_発行日) = Date
                        ws請求明細書.Range(Adrs請求明細書_取引先名) = ws対象データ.Cells(R1st対象データ, CNo対象データ.取引先名)
                        ws請求明細書.Range(Adrs請求明細書_ページNo) = "ー　" & ページNo & "　ー"
                        
                        ws請求明細書.Rows(Adrs請求明細書_2ページ目以降非表示行).Hidden = True
                        
                        R_請求明細 = R1st請求明細書
                        
                    End If
                        
                    ' 対象データ→請求明細への転記
                    ws請求明細書.Cells(R_請求明細, CNo請求明細書.No) = ws対象データ.Cells(R_対象データ, CNo対象データ.No)
                    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対象データ.売上)
                    R_請求明細 = R_請求明細 + 1
                
                Next
            End If
            
            ' 【CSVファイルの出力】
            If is要CSV Then
                Dim 出力CSVファイル名 As String
                出力CSVファイル名 = "請求データ" & 対象年 & "年" & 対象月 & "月" _
                                & "(" & ws請求書.Range(Adrs請求書_取引先名) & ").csv"
                ws対象データ.Copy
                Dim wb出力CSV As Workbook: Set wb出力CSV = ActiveWorkbook
                Application.DisplayAlerts = True
                wb出力CSV.SaveAs path出力フォルダ & "\" & 出力CSVファイル名, xlCSV
                Application.DisplayAlerts = False
                
                wb出力CSV.Close False
                
            End If

            
            ' 【PDFファイルの出力】
            
            ' ファイル名を設定
            Dim 出力ファイル名 As String
            出力ファイル名 = "請求書" & 対象年 & "年" & 対象月 & "月" _
                                & "(" & ws請求書.Range(Adrs請求書_取引先名) & ").pdf"
            
            ' 対象データシートの削除
            ws対象データ.Visible = xlSheetHidden
            
            ' ブック全体をPDFに出力
            wb出力ブック.ExportAsFixedFormat xlTypePDF, path出力フォルダ & "\" & 出力ファイル名
        
次の取引先へ:
            ' 出力ブックを保存せず閉じる
            wb出力ブック.Close False
        
        End If ' 締日が合致した取引先を処理
        
    Next ' マスタをループして対象の取引先を検索

    MsgBox "指定コードの請求書出力を完了しました。"
    
End Sub

' 年度指定の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

解説

各コードの解説と工夫しているポイントは以下の通りです。

全体を通して

「データ→帳票の出力」部分はマクロ①のコードを用いて、
それをさらに大きい「取引先コードごとのForループ」で包んだ設計にしました。

コード全体としては

• 取引先マスタの全ての行をループ
• 対象となる取引先コードにマクロ①のコードを実行

という流れになっています。

メインコードとなるマクロ①部分の工夫ポイント

1. まず対象データだけに絞ったシートを作り、そこから請求書/明細書を作成
   ※ 元データと帳票を直接つなげない
2. ①元データ→抽出データ、②抽出データ→請求書、③抽出データ→明細書
   を一気にやらずに、ブロックを分けてひとつずつ処理
3. ログを残せるように新規ブックにいったん出してからPDFへ
4. シート指定＆セルアドレスは変数＆定数化して管理

について、以下の記事で詳しく解説していますのでまずはこちらを参考ください。

www.limecode.jp

特に「処理を1つずつ区切っておく」ことの重要さがマクロ②に活きています。

マクロ①を

1. 元データから対象データだけを抽出したシートを新規ブックに出力
2. 対象データシートからまずは「請求書」を作成
3. 続いて対象データシートから「請求明細書」を作成

このように処理ごとにブロックを分けて作っていたことで、
マクロ②で「取引先ごとに明細書の有無が変わる」仕様になっても、

' 【請求明細シートの出力】
If is要明細 Then

このIf文の追加だけで対応が終わっています。

逆に「請求書と請求明細書を同じループで同時出力」でマクロ①を組んでいたら、
今回の改修がかなり大変になってしまいますからね。

プログラムはとにかくシングルタスクにしておくと、
コーディング、テスト、メンテナンス、改修すべてが楽になります。

長い処理をマクロにする場合はこの点を意識して設計しましょう。

プロシージャ分割の重要性

今回は「挑戦ポイント非対応版」ということで、
Sub/Functionの分割はほとんど行いませんでした。

このため出来上がったマクロは200行近い長大なFor文になっており、
ここまでくると、むしろ挑戦ポイントに挑戦した方が楽だったと思います。

今回のマクロはプロシージャ分割の恩恵を実感しやすいマクロですので、
ちょうどいい機会ですし、Sub/Function分割を学ぶ題材に使ってみましょう。

以下のページで解説する「挑戦ポイントに対応した完成版解答」は、
処理のロジックをそのままにプロシージャ分割でコードを整理したものにしました。

今回のコードと横に並べて見比べることで、
プロシージャ分割のやり方やメリットを分かりやすく読むことができます。

プロシージャ(Sub/Function)分割を勉強をしてみたいという方は、
絶好の機会ですので是非ご活用ください。

【準備中】