Q&A
閲覧くださいまして、ありがとうございます。
よろしくお願いします。
現在、サイトを参考にexcelで請求書を発行するマクロを組んでおります。
月別かつクライアント別かつ納品日別にしたいと思っておりますが、納品日別にすることができません。
今できていること
・９月で検索すると納品日が９月以降１０月未満のデータが出てくる
・それらをクライアントごとに分けて請求書を発行
できないこと
・同じ月にいくつも納品日があるクライアント様の請求書が１枚にまとめられてしまう→別々にしたい
どうか、よろしくお願いします。
自分なりにいじってしまったので、コードが汚くて本当にすみません。
【納品データ】
| 納品日 | 取引先名 | 商品詳細 | 商品タイトル | 数量 | 単価 | 金額 | 請求書発行日 |
|---|
【請求書雛形】
【取引先一覧】
|取引先名|郵便番号|住所１|住所２|源泉徴収税表記有/無|
|:--|:--:|--:|--:|--:|--:|--:|--:|
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
回答1件
0
ベストアンサー
大きなコードを流用して改修するのは大変な作業です。
特にお金を扱う物となるとなおさら気を使いますよね。
大変ですが確実に改修するためにはやはり１行ずつしっかりコードを理解することが大切です。
まずは全体の流れを正確につかむところから始めましょう。
現在の処理の流れ
提示いただいたコードで請求書データの抽出・出力に絡む主な処理をざっくり書き出すと
①全ての取引先をループ処理 ～取引先ループここから～ ②対象締月のデータが存在すれば請求書作成 ⇒データがなければ次の取引先の処理へスキップ(⑪へ) ③ひな形を元にシートを作成 ④全ての納品データをループ処理 ～納品データループここから～ ⑤1行ずつ納品データ取得 ⑥取得データが現在の取引先のデータでなければ次のデータまでスキップ(⑨へ) ⑦取得データの納品日が締月の年月と一致しなければ次のデータまでスキップ(⑨へ) ※この部分、記述されているコメントとは動作が異なっています。 ⑧取得データの内容を出力シートに転記する ⑨次の納品データがあれば⑤へ ～納品データループここまで～ ⑩合計等を計算し出力 ⑪次の得意先があれば②へ ～取引先ループここまで～ ⑫処理終了
以上のような流れになっていると思います。
日別にした場合の処理の流れ
これに対し、今回は日別にシートを分けたいのだと思います。
もともとは取引先ループの中で１回シートを作成していましたが、今回は取引先ループの中で対象締月の日数分シートを作成することになると思います。
①全ての取引先をループ処理 ～取引先ループここから～ ②対象締月の日数分ループ処理 ～日付ループここから～ ③対象日付のデータが存在すれば請求書作成 ⇒データがなければ次の日付の処理へスキップ(⑬へ) ④ひな形を元にシートを作成 ⑤全ての納品データをループ処理 ～納品データループここから～ ⑥1行ずつ納品データ取得 ⑦取得データが現在の取引先のデータでなければ次のデータまでスキップ(⑩へ) ⑧取得データの納品日が締月の年月日と一致しなければ次のデータまでスキップ(⑩へ) ⑨取得データの内容を出力シートに転記する ⑩次の納品データがあれば⑤へ ～納品データループここまで～ ⑪合計等を計算し出力 ⑫次の日付があれば③へ ～日付けループここまで～ ⑬次の得意先があれば②へ ～取引先ループここまで～ ⑭処理終了
ポイントは
・②で日数分のループを行い、日付ごとにシート作成する
・③対象データの存在チェックは月単位ではなく日単位で行う
⇒wsData.Range("A:A"), ">=" & dayCutoff、wsData.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日の日付) 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 10:31
編集2017/03/01 05:25
総合スコア3013
あなたの回答
tips
プレビュー
バッドをするには、ログインかつ
こちらの条件を満たす必要があります。
2017/02/28 13:16
2017/03/01 01:54
2017/03/02 03:58