質問: p + 1 End If Next h End Sub
回答: 大きなコードを流用して改修するのは大変な作業です。 特にお金を扱う物となるとなおさら気を使いますよね。 大変ですが確実に改修するためにはやはり1行ずつしっかりコードを理解することが大切です。 まずは全体の流れを正確につかむところから始めましょう。 現在の処理の流れ 提示いただいたコードで請求書データの抽出・出力に絡む主な処理をざっくり書き出すと ``` 1全ての取引先をループ処理 ~取引先ループここから~ 2対象締月のデータが存在すれば請求書作成 ⇒データがなければ次の取引先の処理へスキップ(11へ) 3ひな形を元にシートを作成 4全ての納品データをループ処理 ~納品データループここから~ 51行ずつ納品データ取得 6取得データが現在の取引先のデータでなければ次のデータまでスキップ(9へ) 7取得データの納品日が締月の年月と一致しなければ次のデータまでスキップ(9へ) ※この部分、記述されているコメントとは動作が異なっています。 8取得データの内容を出力シートに転記する 9次の納品データがあれば5へ ~納品データループここまで~ 10合計等を計算し出力 11次の得意先があれば2へ ~取引先ループここまで~ 12処理終了 ``` 以上のような流れになっていると思います。 日別にした場合の処理の流れ これに対し、今回は日別にシートを分けたいのだと思います。 もともとは取引先ループの中で1回シートを作成していましたが、今回は取引先ループの中で対象締月の日数分シートを作成することになると思います。 ``` 1全ての取引先をループ処理 ~取引先ループここから~ 2対象締月の日数分ループ処理 ~日付ループここから~ 3対象日付のデータが存在すれば請求書作成 ⇒データがなければ次の日付の処理へスキップ(13へ) 4ひな形を元にシートを作成 5全ての納品データをループ処理 ~納品データループここから~ 61行ずつ納品データ取得 7取得データが現在の取引先のデータでなければ次のデータまでスキップ(10へ) 8取得データの納品日が締月の年月日と一致しなければ次のデータまでスキップ(10へ) 9取得データの内容を出力シートに転記する 10次の納品データがあれば5へ ~納品データループここまで~ 11合計等を計算し出力 12次の日付があれば3へ ~日付けループここまで~ 13次の得意先があれば2へ ~取引先ループここまで~ 14処理終了 ``` ポイントは ・2で日数分のループを行い、日付ごとにシート作成する ・3対象データの存在チェックは月単位ではなく日単位で行う ⇒`wsData.Range("A:A"), ">=" & dayCutoff`、`wsData.Range("A:A"), "<" & DateAdd("m", 1, dayCutoff)`の部分。 ⇒`wsData.Range("A:A"), "=" & 対象日付`のような形になると思います。 ・8出力対象の判定は日単位で行う ⇒`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 ```