質問をすることでしか得られない、回答やアドバイスがある。

15分調べてもわからないことは、質問しよう!

ただいまの
回答率

90.36%

  • VBA

    1898questions

    VBAはオブジェクト指向プログラミング言語のひとつで、マクロを作成によりExcelなどのOffice業務を自動化することができます。

  • Excel

    1624questions

    Excelは、マイクロソフト社が開発しているデータ集計や分析を行う表計算ソフトの一つです。文書作成や表計算、資料作成などの多彩な機能を備えており、統合パッケージであるMicrosoft Officeに含まれています。

  • マクロ

    236questions

    定義された処理手続きに応じて、どのような一連の処理を行うのかを特定させるルールをマクロと呼びます。

月別かつクライアント別かつ納品日別に請求書を作りたい excel VBA

解決済

回答 1

投稿 編集

  • 評価
  • クリップ 0
  • VIEW 2,954

nakamura03

score 17

閲覧くださいまして、ありがとうございます。
よろしくお願いします。
現在、サイトを参考にexcelで請求書を発行するマクロを組んでおります。

月別かつクライアント別かつ納品日別にしたいと思っておりますが、納品日別にすることができません。

今できていること
・9月で検索すると納品日が9月以降10月未満のデータが出てくる
・それらをクライアントごとに分けて請求書を発行

できないこと
・同じ月にいくつも納品日があるクライアント様の請求書が1枚にまとめられてしまう→別々にしたい

どうか、よろしくお願いします。

自分なりにいじってしまったので、コードが汚くて本当にすみません。

【納品データ】

納品日 取引先名 商品詳細 商品タイトル 数量 単価 金額 請求書発行日

【請求書雛形】
イメージ説明

【取引先一覧】

取引先名 郵便番号 住所1 住所2 源泉徴収税表記有/無

Option Explicit
Public wsData As Worksheet '「請求データ」シートを入れるオブジェクト変数
Public wsInvoice As Worksheet '「請求書ひな形」シートを入れるオブジェクト変数
Public wsClient As Worksheet '「取引先一覧」シートを入れるオブジェクト変数
Public rowsData As Long '「請求データ」の行数
Public rowsClient As Long '「取引先一覧」の行数
Sub シート初期化()

Set wsData = ThisWorkbook.Worksheets("納品データ")
Set wsInvoice = ThisWorkbook.Worksheets("請求書雛形")
Set wsClient = ThisWorkbook.Worksheets("取引先一覧")

rowsData = wsData.Cells(Rows.Count, 2).End(xlUp).Row '最後の行数を取得
rowsClient = wsClient.Cells(Rows.Count, 1).End(xlUp).Row  '「取引先マスタ」の最後の行数を取得

wsInvoice.Rows("21:50").Hidden = False  '隠れている行を再表示する
wsInvoice.Rows("44:47").Hidden = False  '隠れている行を再表示する

wsInvoice.Range("B22:D41").ClearContents 'ここに転記先のセル範囲のクリアを入れる

End Sub

Sub 請求書作成()
Dim j As Long, i As Long, n As Long, m As Long, b As Long, c As Long, k As Long, h As Long, p As Long, f As Long

Dim dayData As Date '納品日格納用変数
Dim dayCutoff As Date '締月入力用変数
Dim strClient As String '取引先格納用変数
Dim g As Long

dayCutoff = InputBox("締月を入力してください(例:2016/9)")

Call シート初期化

p = 1

For h = 2 To rowsClient

If WorksheetFunction.SumIfs( _
wsData.Range("G:G"), _
wsData.Range("H:H"), "", _
wsData.Range("A:A"), ">=" & dayCutoff, _
wsData.Range("A:A"), "<" & DateAdd("m", 1, dayCutoff), _
wsData.Range("B:B"), wsClient.Cells(h, 1).Value _
) > 0 Then      

Workbooks.Add '新規ワークブックを作成
ThisWorkbook.Worksheets("請求書雛形").Copy before:=ActiveWorkbook.Sheets(1) '新規ワークブックのsheet1の前にひな形をコピー

Set wsInvoice = ActiveSheet 'コピーしたシートを変数にセット
wsInvoice.Name = "請求書" 'シート名を変更

n = 1
c = 0
k = 0
m = 2

For i = 2 To rowsData

dayData = wsData.Cells(m, 1).Value '現在の行の納品日を取得
strClient = wsData.Cells(m, 2).Value

If wsData.Cells(m, 8).Value = "" Then

If strClient = wsClient.Cells(h, 1).Value Then
If Year(dayData) = Year(dayCutoff) And Month(dayData) = Month(dayCutoff) Then '年が2017でかつ月が9かつ日にちが12の場合は処理を実行

For b = 2 To 5

'納品データを転記
wsInvoice.Cells(22 + k + n, b - c).Value = wsData.Cells(i, b + 1).Value
c = 1
n = 0
Next b
n = 1
k = k + 2
c = 0
If wsData.Cells(i, 8).Value = "" Then
wsData.Cells(i, 8).Value = Format(Date, "yyyymmdd")
End If

End If
End If
End If

m = m + 1

Next i

wsInvoice.Rows(22 + k & ":41").Hidden = True 'データがない行を隠す

wsInvoice.Cells(8, 2).Value = wsClient.Cells(h, 2).Value
wsInvoice.Cells(9, 2).Value = wsClient.Cells(h, 3).Value
wsInvoice.Cells(10, 2).Value = wsClient.Cells(h, 4).Value
wsInvoice.Cells(11, 2).Value = wsClient.Cells(h, 1).Value

wsInvoice.Range("E1").Value = "請求番号:" & (Format(Date, "yyyymmdd")) & "-" & (Format(p, "000"))

If IsEmpty(wsClient.Cells(h, 5)) Then '源泉徴収税のセルが不要ならば
wsInvoice.Rows(44 & ":47").Hidden = True '源泉徴収税、差引額のセルを消す

wsInvoice.Range("B16").Value = "ご請求金額 ¥" & Format(wsInvoice.Cells(42, 5).Value, "#,###,##0") & " -"

Else: wsInvoice.Range("B16").Value = "ご請求金額 ¥" & Format(wsInvoice.Cells(46, 5).Value, "#,###,##0") & " -"

End If

Dim strFile As String '保存先フォルダパス&ファイル名(拡張子抜き)
strFile = ThisWorkbook.Path & "\" & wsClient.Cells(h, 1).Value & "_" & (Format(Date, "yyyymmdd")) & "_" & (Format(p, "000"))
wsInvoice.ExportAsFixedFormat Type:=xlTypePDF, Filename:=strFile & ".pdf" '選択したシートをPDF出力

'*PDF出力設定*
With wsInvoice.PageSetup

.Zoom = False       '倍率をクリア
.FitToPagesWide = 1 '横方向に1ページに収める
.FitToPagesTall = 1 '縦方向に1ページに収める
.CenterHorizontally = True                          '水平方向に中央配置
.TopMargin = Application.CentimetersToPoints(1)     '上マージンを1cm
.BottomMargin = Application.CentimetersToPoints(1)  '下マージンを1cm

End With

wsInvoice.ExportAsFixedFormat Type:=xlTypePDF, Filename:=strFile & ".pdf" '選択したシートをPDF出力
ActiveWorkbook.Close savechanges:=True, Filename:=strFile & ".xlsx" 'アクティブブックを名前を付けて保存して閉じる

p = p + 1

End If

Next h

End Sub

  • 気になる質問をクリップする

    クリップした質問は、後からいつでもマイページで確認できます。

    またクリップした質問に回答があった際、通知やメールを受け取ることができます。

    クリップを取り消します

  • 良い質問の評価を上げる

    以下のような質問は評価を上げましょう

    • 質問内容が明確
    • 自分も答えを知りたい
    • 質問者以外のユーザにも役立つ

    評価が高い質問は、TOPページの「注目」タブのフィードに表示されやすくなります。

    質問の評価を上げたことを取り消します

  • 評価を下げられる数の上限に達しました

    評価を下げることができません

    • 1日5回まで評価を下げられます
    • 1日に1ユーザに対して2回まで評価を下げられます

    質問の評価を下げる

    teratailでは下記のような質問を「具体的に困っていることがない質問」、「サイトポリシーに違反する質問」と定義し、推奨していません。

    • プログラミングに関係のない質問
    • やってほしいことだけを記載した丸投げの質問
    • 問題・課題が含まれていない質問
    • 意図的に内容が抹消された質問
    • 広告と受け取られるような投稿

    評価が下がると、TOPページの「アクティブ」「注目」タブのフィードに表示されにくくなります。

    質問の評価を下げたことを取り消します

    この機能は開放されていません

    評価を下げる条件を満たしてません

    評価を下げる理由を選択してください

    詳細な説明はこちら

    上記に当てはまらず、質問内容が明確になっていない質問には「情報の追加・修正依頼」機能からコメントをしてください。

    質問の評価を下げる機能の利用条件

    この機能を利用するためには、以下の事項を行う必要があります。

回答 1

checkベストアンサー

+1

大きなコードを流用して改修するのは大変な作業です。
特にお金を扱う物となるとなおさら気を使いますよね。

大変ですが確実に改修するためにはやはり1行ずつしっかりコードを理解することが大切です。
まずは全体の流れを正確につかむところから始めましょう。

現在の処理の流れ

提示いただいたコードで請求書データの抽出・出力に絡む主な処理をざっくり書き出すと

①全ての取引先をループ処理
~取引先ループここから~
 ②対象締月のデータが存在すれば請求書作成
  ⇒データがなければ次の取引先の処理へスキップ(⑪へ)
 ③ひな形を元にシートを作成
 ④全ての納品データをループ処理
 ~納品データループここから~
  ⑤1行ずつ納品データ取得
  ⑥取得データが現在の取引先のデータでなければ次のデータまでスキップ(⑨へ)
  ⑦取得データの納品日が締月の年月と一致しなければ次のデータまでスキップ(⑨へ) ※この部分、記述されているコメントとは動作が異なっています。
  ⑧取得データの内容を出力シートに転記する
  ⑨次の納品データがあれば⑤へ
 ~納品データループここまで~
 ⑩合計等を計算し出力
 ⑪次の得意先があれば②へ
~取引先ループここまで~
⑫処理終了


以上のような流れになっていると思います。

日別にした場合の処理の流れ

これに対し、今回は日別にシートを分けたいのだと思います。
もともとは取引先ループの中で1回シートを作成していましたが、今回は取引先ループの中で対象締月の日数分シートを作成することになると思います。

①全ての取引先をループ処理
~取引先ループここから~
 ②対象締月の日数分ループ処理
 ~日付ループここから~
  ③対象日付のデータが存在すれば請求書作成
   ⇒データがなければ次の日付の処理へスキップ(⑬へ)
  ④ひな形を元にシートを作成
  ⑤全ての納品データをループ処理
  ~納品データループここから~
   ⑥1行ずつ納品データ取得
   ⑦取得データが現在の取引先のデータでなければ次のデータまでスキップ(⑩へ)
   ⑧取得データの納品日が締月の年月日と一致しなければ次のデータまでスキップ(⑩へ)
   ⑨取得データの内容を出力シートに転記する
   ⑩次の納品データがあれば⑤へ
  ~納品データループここまで~
  ⑪合計等を計算し出力
  ⑫次の日付があれば③へ
 ~日付けループここまで~
 ⑬次の得意先があれば②へ
~取引先ループここまで~
⑭処理終了

ポイントは
・②で日数分のループを行い、日付ごとにシート作成する
・③対象データの存在チェックは月単位ではなく日単位で行う
wsData.Range("A:A"), ">=" & dayCutoffwsData.Range("A:A"), "<" & DateAdd("m", 1, dayCutoff)の部分。
wsData.Range("A:A"), "=" & 対象日付のような形になると思います。
・⑧出力対象の判定は日単位で行う
If Year(dayData) = Year(dayCutoff) And Month(dayData) = Month(dayCutoff) Thenの部分。
⇒年月だけでなく日付までの考慮が必要。
です。

細かい部分ですが、シート名も得意先単位ではなく日単位となるよう考慮が必要でしょう。

頑張ってみてください。

追記(サンプルコード)

Option Explicit
Public wsData As Worksheet      '「請求データ」シートを入れるオブジェクト変数
Public wsTemplate As Worksheet  '★「請求書ひな形」シートを入れるオブジェクト変数
Public wsInvoice As Worksheet   '★「請求書」シートを入れるオブジェクト変数
Public wsClient As Worksheet    '「取引先一覧」シートを入れるオブジェクト変数
Public rowsData As Long         '「請求データ」の行数
Public rowsClient As Long       '「取引先一覧」の行数

Sub シート初期化()

    Set wsData = ThisWorkbook.Worksheets("納品データ")
    Set wsTemplate = ThisWorkbook.Worksheets("請求書雛形") '★「請求書ひな形」シート
    Set wsInvoice = ThisWorkbook.Worksheets("請求書雛形")
    Set wsClient = ThisWorkbook.Worksheets("取引先一覧")

    rowsData = wsData.Cells(Rows.Count, 2).End(xlUp).Row        '最後の行数を取得
    rowsClient = wsClient.Cells(Rows.Count, 1).End(xlUp).Row    '「取引先マスタ」の最後の行数を取得

    wsTemplate.Rows("21:50").Hidden = False  '隠れている行を再表示する
    wsTemplate.Rows("44:47").Hidden = False  '隠れている行を再表示する

    wsTemplate.Range("B22:D41").ClearContents 'ここに転記先のセル範囲のクリアを入れる

End Sub

Sub 日別_請求書作成()
    Dim j As Long, i As Long, n As Long, m As Long, b As Long, c As Long, k As Long, h As Long, p As Long, f As Long

    Dim dayData As Date     '納品日格納用変数
    Dim dayCutoff As Date   '締月入力用変数
    Dim strClient As String '取引先格納用変数
    Dim g As Long

    Dim dayLoop As Integer  '日付ループカウンタ
    Dim dayLast As Integer  '締月の最終日
    Dim dayPickup As Date   '処理対象の日付


    dayCutoff = InputBox("締月を入力してください(例:2016/9)")

    Call シート初期化

    p = 1

    '★締月の最終日を算出((締月の翌月1日)-1日の日付)
    dayLast = Day(DateAdd("d", -1, DateAdd("m", 1, dayCutoff)))

    For h = 2 To rowsClient
        For dayLoop = 1 To dayLast  '★日付ループここから
            dayPickup = DateAdd("d", dayLoop - 1, dayCutoff) '★対象日付の生成

            If WorksheetFunction.SumIfs( _
            wsData.Range("G:G"), _
            wsData.Range("H:H"), "", _
            wsData.Range("A:A"), "=" & dayPickup, _
            wsData.Range("B:B"), wsClient.Cells(h, 1).Value _
            ) > 0 Then  '日付指定で対象データ有無を判定

                Workbooks.Add '新規ワークブックを作成
                wsTemplate.Copy before:=ActiveWorkbook.Sheets(1) '新規ワークブックのsheet1の前にひな形をコピー

                Set wsInvoice = ActiveSheet 'コピーしたシートを変数にセット
                wsInvoice.Name = "請求書"   'シート名を変更

                n = 1
                c = 0
                k = 0
                m = 2

                For i = 2 To rowsData

                    dayData = wsData.Cells(m, 1).Value '現在の行の納品日を取得
                    strClient = wsData.Cells(m, 2).Value

                    If wsData.Cells(m, 8).Value = "" Then
                        If strClient = wsClient.Cells(h, 1).Value Then
                            If Year(dayData) = Year(dayPickup) And _
                               Month(dayData) = Month(dayPickup) And _
                               Day(dayData) = Day(dayPickup) Then       '★対象日と年月日が同じならデータ出力

                                For b = 2 To 5
                                    '納品データを転記
                                    wsInvoice.Cells(22 + k + n, b - c).Value = wsData.Cells(i, b + 1).Value
                                    c = 1
                                    n = 0
                                Next b
                                n = 1
                                k = k + 2
                                c = 0
                                If wsData.Cells(i, 8).Value = "" Then
                                    wsData.Cells(i, 8).Value = Format(Date, "yyyymmdd")
                                End If

                            End If
                        End If
                    End If

                    m = m + 1

                Next i

                wsInvoice.Rows(22 + k & ":41").Hidden = True 'データがない行を隠す

                wsInvoice.Cells(8, 2).Value = wsClient.Cells(h, 2).Value
                wsInvoice.Cells(9, 2).Value = wsClient.Cells(h, 3).Value
                wsInvoice.Cells(10, 2).Value = wsClient.Cells(h, 4).Value
                wsInvoice.Cells(11, 2).Value = wsClient.Cells(h, 1).Value

                wsInvoice.Range("E1").Value = "請求番号:" & (Format(Date, "yyyymmdd")) & "-" & (Format(p, "000"))

                If IsEmpty(wsClient.Cells(h, 5)) Then '源泉徴収税のセルが不要ならば
                    wsInvoice.Rows(44 & ":47").Hidden = True '源泉徴収税、差引額のセルを消す
                    wsInvoice.Range("B16").Value = "ご請求金額 ¥" & Format(wsInvoice.Cells(42, 5).Value, "#,###,##0") & " -"
                Else
                    wsInvoice.Range("B16").Value = "ご請求金額 ¥" & Format(wsInvoice.Cells(46, 5).Value, "#,###,##0") & " -"
                End If

                Dim strFile As String '保存先フォルダパス&ファイル名(拡張子抜き)

                '★出力ファイル名(納品日を追加)
                strFile = ThisWorkbook.Path & "\" & wsClient.Cells(h, 1).Value & "_" & (Format(Date, "yyyymmdd")) & "_" & (Format(dayPickup, "yyyymmdd")) & "_" & (Format(p, "000"))
                wsInvoice.ExportAsFixedFormat Type:=xlTypePDF, Filename:=strFile & ".pdf" '選択したシートをPDF出力

                '*PDF出力設定*
                With wsInvoice.PageSetup
                    .Zoom = False       '倍率をクリア
                    .FitToPagesWide = 1 '横方向に1ページに収める
                    .FitToPagesTall = 1 '縦方向に1ページに収める
                    .CenterHorizontally = True                          '水平方向に中央配置
                    .TopMargin = Application.CentimetersToPoints(1)     '上マージンを1cm
                    .BottomMargin = Application.CentimetersToPoints(1)  '下マージンを1cm
                End With

                wsInvoice.ExportAsFixedFormat Type:=xlTypePDF, Filename:=strFile & ".pdf" '選択したシートをPDF出力
                ActiveWorkbook.Close savechanges:=True, Filename:=strFile & ".xlsx" 'アクティブブックを名前を付けて保存して閉じる

                p = p + 1
            End If
        Next dayLoop    '★日付ループここまで
    Next h
    MsgBox "完了"
End Sub

投稿

編集

  • 回答の評価を上げる

    以下のような回答は評価を上げましょう

    • 正しい回答
    • わかりやすい回答
    • ためになる回答

    評価が高い回答ほどページの上位に表示されます。

  • 回答の評価を下げる

    下記のような回答は推奨されていません。

    • 間違っている回答
    • 質問の回答になっていない投稿
    • スパムや攻撃的な表現を用いた投稿

    評価を下げる際はその理由を明確に伝え、適切な回答に修正してもらいましょう。

  • 2017/02/28 22:16

    ご丁寧に本当にありがとうございます!!
    参考にさせていただき、一から勉強し直してもう少し頑張ってみます!!

    キャンセル

  • 2017/03/01 10:54

    ひとつ読み落としている部分がありました。
    取引先ごとにシート作成していますが、その前にブックも作成していて、PDF出力後に保存して閉じるような実装になっていますね。
    これであれば日付別の処理に変更してもシート名に納品日を考慮する必要はなさそうです。

    どちらかというと、出力ファイルの量が増えるのでファイル名に納品日が含まれていたほうがわかりやすくなるかもしれません。
    そのままでもページ番号でファイル名は分かれますので、ここらへんは実際の運用に沿って検討すればいいと思います。

    遅くなりましたが、アドバイスした内容を反映してサンプルコードを提示させていただきました。

    変更点は以下の通りです。
    ①締月の最終日の算出
    ②日付でのループ
    ③日付での対象データの抽出
    ④出力ファイル名に納品日を追加

    ※本題とは関係のない修正
    ⑤雛形シートの格納用変数wsTemplateを作成
    ⇒初期化の際にwsInvoiceに雛形シートを設定していますが、wsInvoiceは実際には雛形から出力シートを作成した後に出力シートとして使用されていましたので、雛形シートは出力シートとは別にwsTemplateに設定しておくようにしました。

    参考になれば幸いです。

    キャンセル

  • 2017/03/02 12:58

    確認が遅くなりまして、大変申し訳ございません!!
    サンプルコードまで……何とお礼を申し上げたらいいか。感謝感激です。
    したいことそのものでした!!!!
    一つ一つにコメントもあり、とても分かりやすかったです。
    時間はかかるかもしれませんが、頂いたサンプルをちゃんと理解できるように勉強します。
    本当に本当にありがとうございました!!

    キャンセル

15分調べてもわからないことは、teratailで質問しよう!

  • ただいまの回答率 90.36%
  • 質問をまとめることで、思考を整理して素早く解決
  • テンプレート機能で、簡単に質問をまとめられる

同じタグがついた質問を見る

  • VBA

    1898questions

    VBAはオブジェクト指向プログラミング言語のひとつで、マクロを作成によりExcelなどのOffice業務を自動化することができます。

  • Excel

    1624questions

    Excelは、マイクロソフト社が開発しているデータ集計や分析を行う表計算ソフトの一つです。文書作成や表計算、資料作成などの多彩な機能を備えており、統合パッケージであるMicrosoft Officeに含まれています。

  • マクロ

    236questions

    定義された処理手続きに応じて、どのような一連の処理を行うのかを特定させるルールをマクロと呼びます。