【ExcelVBA】日計から個別帳票へ転記したい

質問

sheet1からsheet2へデータを転記したいです。
参考画像を添付します。

sheet1には、日計の情報があります。
A列に月、B列に日、C列にID、D列に氏名、E列に備考、F列に項目１、G列に項目2です。
1ヶ月分のデータを入力すると、1500～2000行程度のデータ（ID数は200前後）になります。
（サンプル画像は20数件のデータに対して15件ほどのIDです）

sheet2には、各ID毎の月間データを作成し、印刷したいです。
sheet2の、C2にID、G2に氏名、L２に年、N2に月を。
更にその下に日付け毎の記録（実施、項目1、項目2）をつけたいです。
「実施」については、該当日に実施記録があれば◎をつけたいです。

sheet1のC列をVBAで抽出し、K列に重複しないIDを表示させるところまではできました。
sheet1のK列に抽出されたID毎にsheet2を繰り返し処理で完成させれば良いと思うのですが、
「対応表」を眺めていると、セルの配置に規則性がある（？）ので、
何か効率的なVBA記述が出来るのではないかとも思います。

また、sheet2の印刷時、A4用紙1枚に１件の印刷ではなく、２～３件分印刷出来ると望ましいです。
複数のIDをまとめて印刷するのは可能でしょうか？

こういった場合、どのような処理（マクロ記述）をするのが望ましいでしょうか？
お知恵を頂ければ幸いです。

回答No.4

eden3616 · ベストアンサー

No1の方法で作成してみました。

OkWaveの画像が小さくなりすぎるので、クラウドに参考の画像を載せました。
https://www.dropbox.com/s/e83teho0827juya/kekka.jpg?dl=0
上記URLの画像のフォーマットで動作します。
（一番右は実行結果）

(1)下記のVBAコードを標準モジュールに貼付
(2)上記URLの画像を参考に、『format』シートを作成

マクロ「メイン処理」を実行後に表示されるダイアログに対象の「月」を数値で入力してください。
『'▽設定』プロシージャで設定した出力シートが作成され、結果が表示されます。
（重複の削除等はコード内で処理しているため、K列出力などの処理は不要です）

コードで文字数制限の大半を使ったため、詳細な説明は割愛します。
雑多ではございますが、不明な点・解釈違い等あれば補足願います。

■VBAコード

'▽モジュール変数宣言
Option Explicit
Dim mySt(2) As Worksheet
Dim outSt As String
Dim pg_cnt As Long
Dim out_cnt As Long
Dim id_list() As String
Dim item_max As Long
Dim myData() As Variant
Dim myYear As Integer

'▽設定
Private Sub Setting()
'シートに関する設定
Set mySt(0) = Worksheets("format")
Set mySt(1) = Worksheets("Sheet1")
outSt = "出力シート名"
'その他の設定
myYear = 2014
'以下変更不要
pg_cnt = 0
item_max = mySt(1).Cells(Rows.Count, "A").End(xlUp).Row
End Sub

Sub メイン処理()
Dim inp As String, l As Integer, cnt As Integer
Dim myFind As Range, bkFind As Range
Dim nwFind As Range, f As Range, flag As Boolean
'対象月の入力
inp = InputBox("対象の月を入力してください", "対象月の指定")
If inp = "" Then Exit Sub
'各処理を実行
Call Setting '設定プロシージャ読込
Call Get_DataList 'データの格納・IDリストの作成
'IDの数だけ繰り返し処理
For l = 0 To UBound(id_list, 2)
　　'初期化
　　flag = False
　　Set myFind = Nothing
　　'IDを新規検索
　　Set myFind = mySt(1).Columns("C").Find(what:=id_list(0, l), LookIn:=xlValues, lookat:=xlWhole)
　　Set bkFind = myFind '初期の検索セルにセット
　　Set nwFind = myFind '現在の検索セルにセット
　　'2個目以降のIDを検索
　　Do
　　　　Set nwFind = mySt(1).Columns("C").FindNext(nwFind)
　　　　If bkFind.Address = nwFind.Address Then
　　　　　　Exit Do
　　　　Else
　　　　　　Set myFind = Union(myFind, nwFind)
　　　　End If
　　Loop
　　'検索で一致したセルに対し繰り返し処理
　　For Each f In myFind
　　　　'条件（入力月と一致するか）判定
　　　　If f.Offset(0, -2) = inp Then
　　　　　　If flag = False Then
　　'出力シートの作成・ページの追加
　　If cnt Mod 3 = 0 Then Call Copy_Format
　　'項目（ID,氏名,年月）を書出し
　　Call Output_Item(cnt, l, inp)
　　flag = True
　　　　　　End If
　　　　　　'データ（実施,項目1,項目2）を書出し
　　　　　　Call Output_Data(cnt, f)
　　　　End If
　　Next
　　If flag Then cnt = cnt + 1
Next l
End Sub

'▽データの取得・格納
Private Sub Get_DataList()
Dim l As Long, m As Long
With mySt(1)
　　'全データを配列へ格納
　　myData = .Range(.Cells(2, "A"), .Cells(item_max, "G"))
　　'IDと名前の重複しないリスト（配列：id_list）を作成
　　ReDim id_list(1, item_max - 2)
　　For l = 1 To item_max - 1
　　　　If WorksheetFunction.CountIf( _
　　　　　　　　.Range(.Cells(2, "C"), .Cells(l + 1, "C")), _
　　　　　　　　myData(l, 3) _
　　　　　　) = 1 Then
　　　　　　id_list(0, m) = myData(l, 3)
　　　　　　id_list(1, m) = myData(l, 4)
　　　　　　m = m + 1
　　　　End If
　　Next l
　　'id_listの不要な部分を削除
　　ReDim Preserve id_list(1, m - 1)
End With
End Sub

'▽出力シートの作成・フォーマットのコピー
Private Sub Copy_Format()
Dim ws As Worksheet
Dim flag As Boolean
Dim l As Integer
Dim ckSt As String
If pg_cnt = 0 Then
　　'初期実行時に出力シートを作成・名前の変更（重複時は連番添付）
　　mySt(0).Copy after:=Worksheets(Sheets.Count)
　　Set mySt(2) = ActiveSheet
　　Do
　　　　flag = False
　　　　For Each ws In Worksheets
　　　　　　If l = 0 Then ckSt = outSt Else ckSt = outSt & "(" & l & ")"
　　　　　　If ws.Name = ckSt Then flag = True
　　　　Next
　　　　l = l + 1
　　Loop While flag
　　mySt(2).Name = ckSt
Else
　　'出力シートへページの追加
　　mySt(0).Rows("1:40").Copy mySt(2).Rows(pg_cnt * 39 + 1)
　　mySt(2).PageSetup.PrintArea = Range("A1", Cells((pg_cnt + 1) * 39, "R")).Address
End If
pg_cnt = pg_cnt + 1
End Sub

'▽出力シートへ項目（ID,氏名,年月）を書出し
Private Sub Output_Item(cnt As Integer, l As Integer, inp As String)
Dim target As Range
Set target = mySt(2).Cells((cnt Mod 3) * 13 + 2 + (pg_cnt - 1) * 39, 3)
target = id_list(0, l)
target.Offset(0, 4) = id_list(1, l)
target.Offset(0, 9) = myYear
target.Offset(0, 11) = inp
End Sub

'▽出力シートへデータ（実施,項目1,項目2）を書出し
Private Sub Output_Data(cnt As Integer, f As Range)
Dim target As Range
Dim myDay As Integer
myDay = Int(f.Offset(0, -1)) '検索セルの日付を取得
Set target = mySt(2).Cells( _
　　Int(myDay / (15 + 1)) * 5 + 5 + (cnt Mod 3) * 13 + (pg_cnt - 1) * 39, _
　　myDay Mod (15 + 1) + 1 + Int(myDay / (15 + 1)) _
　　)
target.Offset(0, 0) = "◎" '実施
target.Offset(1, 0) = f.Offset(0, 3) '項目1
target.Offset(2, 0) = f.Offset(0, 4) '項目2
End Sub

補足

恐ろしく高機能なものを有難うございます。
悲しいかな、自分ではほんの一部しか理解できません・・・。
今後、ボツボツ勉強し、何が行われているのか少しでも理解してみたいです。

早速コードを貼り付けて実験してみましたところ、
氏名が入らなく、年がN列（１件目はN2）に、月がP列（１件目はP2）に入りました。
このズレについては、フォーム作成時にID欄と氏名欄をセル結合した事が原因でした。
（コードの一部を下記のように一部変更して事なきを得ました）

target.Offset(0, 2) = id_list(1, l)
target.Offset(0, 7) = myYear
target.Offset(0, 9) = inp

あと、追記で申し訳ないですが、このファイルは、１ヶ月毎に新しいものにして利用します。
（1ヶ月に200件前後の当月集計をしたら、また次の1ヶ月集計に向けてsheet1に新たな入力をします）
古い物は、バックアップファイルとして１ヶ月分（１ファイル）ずつ保存しておきます。
（◯年８月の実施記録、◯年９月の実施記録・・・の様に月の値はファイルごとに同一です）
現状の「月」を聞いて頂くパターンでも、当月の値を入力すれば全く問題無いです。
（年が変わる時には、Private Sub SettingのmyYearを変更すればよいですよね？）

今後のメンテナンス（状況に応じた修正）等を考えると、予想以上の高機能でコードの理解が・・・。
その辺は自助努力し、将来的には理解できるようになりたいと思います。

文字通り、「身に余る」ご指導を頂き、誠に有難うございます。
今は実験用シートで検証しただけなので、
数日中に実際に使うシートでformatを用意し、実際に利用してみます。
また「お礼コメント」として、近々ご報告いたします。

回答No.6

eden3616

省いていた細かいコードの説明をふまえて、捕捉に対するコメントにお答えいたします。

■(1)
>早速コードを貼り付けて実験してみましたところ、
>氏名が入らなく、年がN列（１件目はN2）に、月が
>P列（１件目はP2）に入りました。

画像見て作成したつもりが、ズレていたようで失礼しました。
targetがIDセルとなり、offset(行,列)で相対的に
氏名、年、月の入力セルを指定していますので適切に変更願います。

■(2)
>このファイルは、１ヶ月毎に新しいものにして利用します。
>古い物は、バックアップファイルとして１ヶ月分ずつ保存

マクロを記述するブックと、データが格納されたブックを分けた方がよいかと思います。
そのために、『Setting』プロシージャで以下のコード修正が必要です。

Set mySt(0) = ThisWorkbook.Worksheets("format") '←変更
Set mySt(1) = ActiveWorkbook.Worksheets("Sheet1") '←変更

ここで、「Sheet1」と固定の名前でない場合は
一番左のシートを対象とするでも良いかと思います。
その場合は以下のようにしてください。
Set mySt(1) = ActiveWorkbook.worksheets(1) '←変更(左から1番目のシート)

新規ブックを作成し、マクロを記述・formatを作成したうえで
xlsまたはxlsm形式（マクロ有効ブック）で保存します。
マクロブックと作業対象ブックを開き、作業対象ブックをアクティブにした状態で
マクロブックの「メイン処理」を実行で同様に動作致します。

■(3)
>現状の「月」を聞いて頂くパターンでも、当月の値を入力すれば全く問題無いです。

『メイン処理』プロシージャの「inp」の指定部分を以下のように
変更すると、実行時の対象シートのA2セルを月として扱います。

'対象月の入力
inp = mySt(1).Range("A2")　 '←変更
'If inp = "" Then Exit Sub　'←削除

■(4)
>（年が変わる時には、Private Sub SettingのmyYearを変更すればよいですよね？）

それで大丈夫です。
年度の指定がなかったので変数(myYear)で変更できるように作成しました。

■(5)>
>今後のメンテナンス（状況に応じた修正）等を考えると、

メンテナンス性として問題がありそうなのはバグ発生時の対応と
変数で取り扱っている意味・フォーマット変更による対応
あたりではないでしょうか。

それほど難しいコードではなりませんので、前者は頑張ってください。
前回の回答では省きましたが、後者について説明します。

◇⓪各プロシージャの処理について

・『メイン処理』
　各処理のプロシージャを呼び出し、IDの数だけループ処理・条件判定します。
・『Setting』
　モジュール変数を最初に設定することで、
　共通で使う変数の初期値設定を行います。
・『Get_DataList』
　対象シートのA2～G列の最終行までのセルの値を配列変数（myData）に格納します。
　IDと氏名の重複しないリスト（id_list）を上から出てきた順に作成します。
・『Copy_Format』
　ページが存在しない場合（pg_cnt=0）は、formatシートのコピーをします。
　存在する場合（pg_cnt>0）はページを新たに追加します。
・『Output_Item』『Output_Data』
　変数（cnt、pg_cnt、myDay）などを用いて出力先の基点セル（target）を
　算出し、起点セルからの相対（offset）セルへ値を書出します。

◇②モジュール変数について
モジュール変数は各プロシージャから共通として使用できる変数です。
格納後は、どのプロシージャからでも下記の値を取得することが出来ます。

・mySt(0)～mySt(2)
　mySt(0)が"format"の、mySt(1)が対象の、mySt(0)が出力先のシートの
　オブジェクト変数になります。
・outSt
　出力先シートのベースの名前になります。同じ名前がある場合は
　シート名の変更時に処理中のDo～Loopで「(1)～(n)」の添え字が付きます。
・item_max
　対象シートの（Ａ列）最終行が格納されます。
・myData(n,m)
　対象のシートにあるデータを配列変数に格納しています。
　要素の範囲は「myData(1,1)～myData(最終行数,最終列数)」となり
　myData(1,1)はセルA2の値になります。
・id_list(n,m)
　対象のシートのC,D列より以下のような重複しないリストを格納しています。
　　　　ｍ　　ｎ＝0　 ｎ＝1
　　　　０　　00003　氏名3
　　　　１　　00001　氏名1
　　　　２　　00002　氏名2
　　　　￤　　　￤　　　￤
　m=0～xの要素に対し、n=0でID、n=1で氏名となります。
　id_list(0,0)で「00003」、id_list(1,0)で「氏名3」となります。
・pg_cnt
　出力先シートの現在のページ数が格納されます。
　0でページが無い => シートもない状態になります。
　1で1ページ、2で2ページとなります。
・myYear
　出力する年度の値が格納されています。
　変更の際はSettingプロシージャで変更してください。
・out_cnt
　ごめんなさい使ってません。消してください。

◇③フォーマットについて

文字数オーバーで書き込めなくなりそうなので次の回答に回します。
読みづらくなりまして、すいません。

■(6)
>予想以上の高機能でコードの理解が・・・。
>その辺は自助努力し、将来的には理解できるようになりたいと思います。

細かい対応につきましてはこの質問でお答えできる限り対応致しますが、
大きく問題が発生する場合は別途質問として上げ直してください。

■(7)
>今は実験用シートで検証しただけなので、

バグ潰しは入念に『行っていません』ので、
想定外のエラーが発生する可能性があります。
その際は、エラー内容、VBEにおいてF8によるステップ実行、その時の変数の値、
成功する例と失敗する例の差異などを睨めっこすれば解決の糸口となるかもしれません。
修正が困難なようであれば、補足または別途質問願います。
（別途質問に気づかなければ申し訳ありませんが。）

お礼

参考書のような細かな解説、恐縮です！
今回の回答、当方の知識では読んだだけで理解出来ないので、
ＶＢＡ勉強用の参考書として活用させて頂きます。
一つ一つ検証し、学んでみたいと思います。

さて、実際に使うファイルで検証してみましたところ、うまく動きました。
ただ、「出力シート」を印刷する際、4件目までは1枚の紙（A4）に入りますが、
5件目が途中で切れて次の紙に印刷されます。
これは印刷設定で1枚に4件とかをＶＢＡで指定出来るのかやってみます。
この手の指定はやったことがないので、調べながらやってみます。
余り困難なら、また「教えてgoo」で再質問させて頂きます。

回答No.5

nonamochi

おはようございます

回答ありがとうございます。
ID数分のデータが等間隔でずらずらと下方向に並んでいると言う事なので、それを元にしてざっくりと処理の概略のみ書きます。なお、あくまでも処理の流れを掴む事を目的にしてますので、見やすさを考慮して、変数名にはわざと日本語を使用しています。
また、これ以外に実際にデータを取得する処理、ID順位を求める処理等の細かい処理が必要になります。

基準列位置 = 2
基準行位置 = 5
次ID間隔 = 15
次段間隔 = 5
日付位置
次段落 = 0

以下IDの数だけ繰り返し

日付位置 = 入力データの日付

if 日付位置>=16 then
日付位置= 日付位置-15
次段落=1
else
次段落 = 0
end if

Cells(基準行位置 + (ID順位-1) x 次ID間隔 + 次段落 x 次段落間隔, 基準列位置 + 日付位置).value = Data1
Cells(基準行位置 + (ID順位-1) x 次ID間隔 + 次段落 x 次段落間隔 + 1, 基準列位置 + 日付位置).value = Data2
Cells(基準行位置 + (ID順位-1) x 次ID間隔 + 次段落 x 次段落間隔 + 2, 基準列位置 + 日付位置).value = Data3

ここまで繰り返し

なお、ここでは3種類の処理方法が考えられます。
1. K列に書き出したID分だけ、全てのデータを繰り返し処理する。
つまり、IDが200、データ数が2000の場合、200 x 2000回ループを回す事になります。

2. まず初めにK列に書き出したIDをシート2の所定のIDの位置に書き込み、その後シート1のデータを1回だけ上から下に移動しながら、シート2の該当するIDの表の中にデータをはめ込んでいく。

3. シート1のデータだけそのまま使用して、上から下まで1回だけ移動しながらシート2にデータを埋め込んでいく。この時IDが既出の場合はその表の中にデータをはめ込み、新規に出てきた時にはまっさらな表にIDを記入してデータをはめ込む。

1の方法はループをかなりの回数回す事になるし、あまり美しくは無いです。
私がやるとしたら3の方法ですね。
いずれの方法でも、データを書き込む位置の決定には上の方法が使えます（それぞれ若干の違いはありますが）。

なお印刷ですが、十分なIDの数だけ表を作成したシート2のテンプレートをあらかじめ作成しておき、適当な所で改ページを入れておけばいいのでは？実際にデータを入れ込む時に、使わなかったシート部分はプログラムで削除すれば余分なページを出力する事はないです。

ざっと書きましたので、多分わかりずらいと思います。また、間違いがあるかもしれません。
わからない事があれば遠慮無く聞いてくださ。

お礼

御回答、有難うございます！
１，２，３の方法だと、たしかに3がスマートな感じですね。

印刷の部分、「改ページ」の設定をした事が無いので、ちょっと調べてみます。
別の回答の方の方法でも、この「改ページ」はクリアすべき課題となりました。

自分のスキルアップも兼ねて、ちょっと努力してみます。
またどうにも分からなければ、再質問いたします。
有難うございました！

回答No.3

nonamochi

お答えする前に一つ確認したい事があります。
シート2ではID毎に集計していくわけですが、例えばIDが20あった場合には、同様な表がシートの下方向に向かってID20個分、一定間隔でずらずらと続いて行く形になりますか？
それとも集計表は1つだけで、ID１つの集計が終わった時点で印刷し、その後集計表をクリアし、別のIDの集計を行うと言う形になりますか？

補足

ご親切に有難うございます。

実際に集計するIDは200前後だと思います。
ずらずら～っと当月の集計表が並び、丁度良い印刷範囲で印刷できれば最良では有りますが・・・。
処理上難しければ、1件1件を繰り返し処理で印刷（A4用紙1枚に1件の集計）するのもOKです。
印刷用紙のスペースが勿体無い感じもしますが・・・。

転記の方法については、下記の様なプランも考えてみました。
（別に計算シートを用意して、必要な抽出データをコピペした状態を想定）
コードは初心者なので間違いだらけだと思います。
いつもエラーを出しながら、少しづつ修正しているので。
ご参考までに添付します。

※　ID毎に抽出したら計算シートにコピペ。（IDの数だけ繰り返すことになる）

抽出後データの最終行を判別。
最終行は、変数jgyou2とする。

jgyou2 = Worksheets("計算シート").Cells(Worksheets("計算シート").Rows.Count, 1).End(xlUp).Row

「日」の値を上から、jgyou2（抽出データの行数）の数だけ繰り返し取得。
これを変数atai1（日付の値）とでもしておく。
この際、atai2に項目1、atai3に項目2が入るようにする。

調査場所（行数）は、hanpukuとする。

hannpuku = 2 to jgyou2

atai1 = worksheets(“計算シート”).cells(hanpuku,2).value
atai2= worksheets(“計算シート”). cells(hanpuku,6).value
atai3 = worksheets(“計算シート”). cells(hanpuku,7).value

「日」の値(atai1)を識別し、15以内なら処理A。
16以上31以内なら処理Bとする。

処理A

worksheet(“sheet2”).cells(5,atai1 + 1).value = “◎”
worksheet(“sheet2”).cells(6,atai1 + 1).value = atai2
worksheet(“sheet2”).cells(7,atai1 + 1).value = atai3

処理B

worksheet(“sheet2”).cells(10,atai1 + 1).value = “◎”
worksheet(“sheet2”).cells(11,atai1 + 1).value = atai2
worksheet(“sheet2”).cells(12,atai1 + 1).value = atai3

その他、ID毎の抽出などせず、sheet1のIDを検索ID（200前後）毎に順番に下まで（2000行前後）見て、
同一IDを見つけたら、1つ左をatai1、3つ右をatai2、4つ左をatai3とする方法も考えています。
計算シートにコピペ（200回程）をしない分、こっちの方がサクサク動くのかなぁ？

回答No.2

nonamochi

こんばんは

なかなかおもしろそうな処理ですね。

取りあえずデータの書き出し部分だけ。
シート2のID毎のデータは一定間隔で並んでいるはずですから、1つのID分の処理を書いてあげれば全てのIDに対応できます。
K列に書き出したIDの出現順位を行の間隔に掛け、書き出す行番号を求めればいいです。

お礼

なるほど、1件1件の処理は同じですので、1つの書き出し方法が流用できそうですね。
ただ、書き出しの際に、1日あたり3項目（◎付け、項目１、項目２）があり、
その入力先はsheet2の対応表のようになっています。

１日あたりの項目は３つでも、転記先が31箇所あるので、どのように指定したものかと悩んでおります。
それがご回答にあります「K列に書き出したIDの出現順位を行の間隔に掛け、書き出す行番号を求めれば」という部分ですか？
イマイチ理解が出来ないのですが、「掛ける」とはどういった処理でしょうか？

先のご回答者様から、画像が見えないとのご指摘を頂きましたので、
とりあえず「対応表」の解説と中身を記載しておきます。

※◯月1日の実施記録
sheet2のB5セルに、1日の実施（1日に実施が有れば◎が入る）が入る。
sheet2のB6セルに、1日の実施に対する項目1が入る。
sheet2のB7セルに、1日の実施に対する項目2が入る。

※◯月2日の実施記録
sheet2のC5セルに、2日の実施（2日に実施が有れば◎が入る）が入る。
sheet2のC6セルに、2日の実施に対する項目1が入る。
sheet2のC7セルに、2日の実施に対する項目2が入る。

・・・

※◯月16日の実施記録
sheet2のB10セルに、16日の実施（16日に実施が有れば◎が入る）が入る。
sheet2のB11セルに、16日の実施に対する項目1が入る。
sheet2のB12セルに、16日の実施に対する項目2が入る。

・・・以下、◯月31日まで続きます・・・。

sheet2の各日の欄に、実施（◎）、項目１、項目２を順に入れたいです。

1日：B列５～７のセル
2日：C列５～７のセル
3日：D列５～７のセル
4日：E列５～７のセル
5日：F列５～７のセル
6日：G列５～７のセル
7日：H列５～７のセル
8日：I列５～７のセル
9日：J列５～７のセル
10日：K列５～７のセル
11日：L列５～７のセル
12日：M列５～７のセル
13日：N列５～７のセル
14日：O列５～７のセル
15日：P列５～７のセル

16日：B列10～12のセル
17日：C列10～12のセル
18日：D列10～12のセル
19日：E列10～12のセル
20日：F列10～12のセル
21日：G列10～12のセル
22日：H列10～12のセル
23日：I列10～12のセル
24日：J列10～12のセル
25日：K列10～12のセル
26日：L列10～12のセル
27日：M列10～12のセル
28日：N列10～12のセル
29日：O列10～12のセル
30日：P列10～12のセル
31日：Q列10～12のセル

回答No.1

eden3616

>「対応表」を眺めていると、セルの配置に規則性がある（？）ので、
>何か効率的なVBA記述が出来るのではないかとも思います。

対応表が何を示しているのか不明ですが（画像が見にくいので）、
1～2000行まであるデータを集約して条件に一致したら
順に書き出していけばいいのではないでしょうか。
規則性については、睨めっこして閃いてください。

>また、sheet2の印刷時、A4用紙1枚に１件の印刷ではなく、
>２～３件分印刷出来ると望ましいです。
>複数のIDをまとめて印刷するのは可能でしょうか？

出力する順番に決まりがあるのか、順不同で全て印刷するのか
指定範囲のみ印刷するのか・・・条件により変わってくるかと思いますが。

たとえば処理の流れとしては、

Sheet1を作業用シートとしてコピーし、セルの並び替え、重複削除等を
駆使しながら必要データを目的のデータとなるように処理。
この処理は、全て配列で処理しようとすると複雑になりますが、
作業用シートを用いてオートフィルタでやりくりすれば
マクロの記録だけでもなんとかなったりします。

別途formatシートを作成し、1ページに等間隔で3件分のSheet2の表を
作っておいて出力シートへフォーマットシートをコピーし、
データを転機していけばいいんじゃないでしょうか？

この場合、1ページ3件ですので、5件印刷するときはフォーマットから
出力シートへ2ページ分のフォーマットをコピー（最大6件分の表になる）し、
規則性を持って作業用シートからデータを転記するなど。

印刷範囲をページ数から割り出して設定したうえで印刷すればよいかと。

お礼

早速のご回答、有難うございます！
画像が見にくくてご迷惑をおかけいたします。

「対応表」は、sheet2のどのセルに何のデータを入れるかの一覧表です。

sheet1のK列には、AからG列までの日計情報のC列（ID欄）から、重複しないIDを抽出してあります。
これらのIDをループで順に指定し、AからG列をフィルタで抽出します。
（各IDの1ヶ月分の実施記録になります）・・・(1)（IDの数だけ繰り返す）

(1)のデータを、sheet2（IDごとの実施記録簿）に転記して印刷したいのです。

※◯月1日の実施記録
sheet2のB5セルに、1日の実施（1日に実施が有れば◎が入る）が入る。
sheet2のB6セルに、1日の実施に対する項目1が入る。
sheet2のB7セルに、1日の実施に対する項目2が入る。

※◯月2日の実施記録
sheet2のC5セルに、2日の実施（2日に実施が有れば◎が入る）が入る。
sheet2のC6セルに、2日の実施に対する項目1が入る。
sheet2のC7セルに、2日の実施に対する項目2が入る。

・・・

※◯月16日の実施記録
sheet2のB10セルに、16日の実施（16日に実施が有れば◎が入る）が入る。
sheet2のB11セルに、16日の実施に対する項目1が入る。
sheet2のB12セルに、16日の実施に対する項目2が入る。

・・・以下、◯月31日まで続きます・・・。（この作業を(2)とします）

sheet2の1日から31日まで、3項目ずつの配列などを利用するのが良いのか、
何かこういった場合の画期的な処理が有るのかと迷っています。

頂いたご回答に有りました「出力の順番」については、
sheet1のK列に抽出してあるIDを上から順に指定したいです。

フォーマットシートにあらかじめ２～３件分の入力欄を用意するのは良さそうですね。
ただ、sheet1のK列のIDを順にフィルタ抽出した際、何件目の場合はどこに入力とかの指定が必要ですね。
これは1ページに2件（上段と下段）なら、該当IDの行数が偶数か奇数かで上下の段を区別できそうですね。

上記作業のうち、(1)までは出来そうですが、(2)の部分の処理がよく分かりません。

以下、ご参考までに、画像では見えづらい「対応表」の内容です。
sheet2の各日の欄に、実施（◎）、項目１、項目２を順に入れたいです。

1日：B列５～７のセル
2日：C列５～７のセル
3日：D列５～７のセル
4日：E列５～７のセル
5日：F列５～７のセル
6日：G列５～７のセル
7日：H列５～７のセル
8日：I列５～７のセル
9日：J列５～７のセル
10日：K列５～７のセル
11日：L列５～７のセル
12日：M列５～７のセル
13日：N列５～７のセル
14日：O列５～７のセル
15日：P列５～７のセル

16日：B列10～12のセル
17日：C列10～12のセル
18日：D列10～12のセル
19日：E列10～12のセル
20日：F列10～12のセル
21日：G列10～12のセル
22日：H列10～12のセル
23日：I列10～12のセル
24日：J列10～12のセル
25日：K列10～12のセル
26日：L列10～12のセル
27日：M列10～12のセル
28日：N列10～12のセル
29日：O列10～12のセル
30日：P列10～12のセル
31日：Q列10～12のセル