ExcelVBAで困っています

前回、mike32様にＶＢＡを教えていただいて作成したのですが
どうしてもできないことがあって投稿させていただきました。
下記はmike32様に教えて頂いたＶＢＡを実際に使用する内容に変更したものです。

ブックシート１に【作付調査Data】シート2に【元帳Tamplate】
内容は作付調査Dataを氏名別に元帳Tamplateへ転記するものです。
元帳はＡ4サイズで印刷するため１ページあたり作付Data11レコード分しか表示できません。
個人のDataが１１レコード以内であれば問題ないのですが以上になった場合次ページが必要になります。
元帳は1～７行まではヘッダーとして利用。８行～29行までがDataの内容を転記するイメージです。1～29行を１ページとしています。以降２ページ＝30行～５９行を繰り返すイメージです。

次ページは１～７行目までは同一人物であればヘッダー的な標記になるためそのまま次ページへ１～７行目を転記し８行目から１２レコード以降のデータを転記していく事にしたいのですがなかなかできません。どなたか教えてもらえませんでしょうか。宜しくお願い致します。

Option Explicit

Dim shData As Worksheet
Dim shTemp As Worksheet
Dim dataRow As Long
Dim tempRow As Long
'一人当たりの最大行数
Const MAX_ROW = 100

Sub sbTest()
Dim sNo As String
Dim iKei As Long
Dim iCnt As Long

Set shData = Worksheets("作付調査Data")
Set shTemp = Worksheets("元帳Template")

dataRow = 2 'データシートの開始行
tempRow = 1 'テンプレートシートの開始行

'氏名NOを取得
sNo = shData.Cells(dataRow, 1)

'氏名NOがNULLになるまでループ
Do Until sNo = ""
'ヘッダーの設定　ヘッダー＝6
Call sbHeader
iCnt = 6

'氏名NOが変わるまでループ
Do Until shData.Cells(dataRow, 1) <> sNo
With shData
iKei = 0
tempRow = tempRow + 1

'品種Code
shTemp.Cells(tempRow, 1) = .Cells(dataRow, 6)
tempRow = tempRow + 1

'品種名
shTemp.Cells(tempRow, 1) = .Cells(dataRow, 7)
'7月-1
shTemp.Cells(tempRow, 6) = fnTsuki(.Cells(dataRow, 8), iKei)
'7月-2
shTemp.Cells(tempRow, 7) = fnTsuki(.Cells(dataRow, 9), iKei)
'7月-3
shTemp.Cells(tempRow, 8) = fnTsuki(.Cells(dataRow, 10), iKei)
'8月-1
shTemp.Cells(tempRow, 9) = fnTsuki(.Cells(dataRow, 11), iKei)
'8月-2
shTemp.Cells(tempRow, 10) = fnTsuki(.Cells(dataRow, 12), iKei)
'8月-3
shTemp.Cells(tempRow, 11) = fnTsuki(.Cells(dataRow, 13), iKei)
'9月-1
shTemp.Cells(tempRow, 12) = fnTsuki(.Cells(dataRow, 14), iKei)
'9月-2
shTemp.Cells(tempRow, 13) = fnTsuki(.Cells(dataRow, 15), iKei)
'9月-3
shTemp.Cells(tempRow, 14) = fnTsuki(.Cells(dataRow, 16), iKei)
※文字数オーバーの為省略
'5月-1
shTemp.Cells(tempRow, 36) = fnTsuki(.Cells(dataRow, 38), iKei)
'5月-2
shTemp.Cells(tempRow, 37) = fnTsuki(.Cells(dataRow, 39), iKei)
'5月-3
shTemp.Cells(tempRow, 38) = fnTsuki(.Cells(dataRow, 40), iKei)
'6月-1
shTemp.Cells(tempRow, 39) = fnTsuki(.Cells(dataRow, 41), iKei)
'6月-2
shTemp.Cells(tempRow, 40) = fnTsuki(.Cells(dataRow, 42), iKei)
'6月-3
shTemp.Cells(tempRow, 41) = fnTsuki(.Cells(dataRow, 43), iKei)

End With
'計
shTemp.Cells(tempRow, 5) = iKei
tempRow = tempRow
iCnt = iCnt + 2
'次の行へ
dataRow = dataRow + 1
Loop

'一人当たりの最大行数まで
If iCnt < MAX_ROW Then
tempRow = tempRow + (MAX_ROW - iCnt)
End If

'氏名NOをセット
sNo = shData.Cells(dataRow, 1)
Loop

MsgBox "終了"
End Sub

Private Sub sbHeader()
'年度　
shTemp.Cells(tempRow, 1) = shData.Cells(dataRow, 4)
'調査日
With shTemp.Cells(tempRow, 14)
.Value = shData.Cells(dataRow, 5)
.NumberFormatLocal = "m/d"
End With
tempRow = tempRow + 2
'生産者NO
shTemp.Cells(tempRow, 4) = shData.Cells(dataRow, 1)
'氏名
shTemp.Cells(tempRow, 6) = shData.Cells(dataRow, 2)
'支部
shTemp.Cells(tempRow, 13) = shData.Cells(dataRow, 3)
tempRow = tempRow + 3

'固定行(A)
shTemp.Cells(tempRow, 1) = "品種作型名"
shTemp.Cells(tempRow, 5) = "計"
shTemp.Cells(tempRow, 6) = "7月"
shTemp.Cells(tempRow, 9) = "8月"
※文字数オーバーの為省略
shTemp.Cells(tempRow, 36) = "5月"
shTemp.Cells(tempRow, 39) = "6月"
tempRow = tempRow + 1

'固定行(B)
shTemp.Cells(tempRow, 6) = "上"
shTemp.Cells(tempRow, 7) = "中"
shTemp.Cells(tempRow, 8) = "下"
shTemp.Cells(tempRow, 9) = "上"
shTemp.Cells(tempRow, 10) = "中"
shTemp.Cells(tempRow, 11) = "下"
shTemp.Cells(tempRow, 12) = "上"
※文字数オーバーの為省略
shTemp.Cells(tempRow, 39) = "上"
shTemp.Cells(tempRow, 40) = "中"
shTemp.Cells(tempRow, 41) = "下"
End Sub

'各月の数量がゼロのときは空欄にする
Function fnTsuki(kazu As Long, iKei As Long) As Variant
If kazu = 0 Then
fnTsuki = ""
Else
iKei = iKei + kazu
fnTsuki = kazu
End If
End Function

質問者からの補足コメント

• 以降２ページ＝30行～５９行を繰り返すイメージです。
  30～58の間違いです。

    補足日時：2018/01/09 14:17

• 

  大変遅くなり申し訳ございません。
  データですが年３回の調査があり３回元帳シートを印刷しないといけません。上書き希望です。
  １回目は添付データの元帳tamplate
  ２回目は添付データの元帳（12月）
  ３回目は添付データの元帳（3月）
  
  １回目は７月～6月のデータを転記※12月は作付dataの12月-1が上旬　12月-3が中旬　12月-5が下旬
  に転記となります。３月も同じです。
  
  2回目は11月～6月のデータを転記※7～10月転記なし　3月は作付dataの3月-1が上旬　3月-3が中旬　3月-5が下旬に転記となります。
  
  3回目は11月～6月のデータを転記※同上　12月は12-1が上旬・・・
  
  http://www.taiyo-hana2.jp/wp-content/uploads/201 …

  No.7の回答に寄せられた補足コメントです。 補足日時：2018/01/10 15:11

• 

  【元帳tamplate】【元帳tamplate（12月）】【元帳tamplate（3月）】
  のシートが原紙として利用したいシートになります。
  お忙しい中本当に親身になって相談に乗っていただき誠にありがとうございます。
  宜しくお願い致します。

    補足日時：2018/01/10 15:16

• 

  ご連絡ありがとうございます。
  ①の回答です　空白です。
  ②の回答です　空白です。
  ※基本、何も取引のない月は空白になります。
  ③の回答です　作付dataシートにあるデータは空白部分を0にしても問題ないのですが、元帳template
  に転記、印刷する際、０表示のまま印刷されると厳しいです。空白にするのはそこに帳票を受け取った人が数字を手書きで書き込むためです。印刷する際にexcelのオプションでゼロ値のセルにゼロ値を表示するのチェックを外せば空白になりますか？
  ④元帳templateのパターンは3パターン（通常7～6月、12月用、3月用）のみで完全固定になります。

  No.8の回答に寄せられた補足コメントです。 補足日時：2018/01/10 16:32

• 

  ありがとうございます。
  Ｔ1、Ｕ1、Ｖ1　の３セルを全ての『template』で結合してNo.1001-1のように表示したいです。
  宜しくお願いします。

  No.9の回答に寄せられた補足コメントです。 補足日時：2018/01/10 16:55

• 

  ④についてです。
  実は１回目は6月に一斉に7～6月の一年分の調査を行い、それを作付調査dataとして入力して入力dataをtemplateに転記し帳票を印刷します。
  
  2回目は10月に行うのですが、一回目に出力した帳票をもとにその内容に変更がないかの調査です。変更のある個所のみ作付調査dataを修正します。２回目の調査時に12月-2、4、6へ初めてデータがあれば入力します。変更がなければ一回目と全く同じdataになりますが、12月のみ3区切りから6区切りに変更します。そのdataを（元帳12月）として出力したいです。
  
  3回目は2月に行います。2回目に出力した帳票をもとに調査します内容は一緒で12月の6区切りが3月に変更になるだけです。
  
  全てのもとになる作付dataは3回の調査で変更がなければ12月と3月の表示形式が6区切りになり細かくなるだけです。
  　
  宜しくお願いします。

  No.10の回答に寄せられた補足コメントです。 補足日時：2018/01/10 17:31

• 

  補足です。
  誤解を招くのでこの文言はカットしてください。『が、12月のみ3区切りから6区切りに変更します。』　『で12月の6区切りが3月に変更になるだけです。』
  
  2回目の調査時に印刷する際、修正した11月～6月のデータを（元帳12月）に転記し印刷できればＯＫです。
  
  3回目の調査時に印刷する際、修正した11月～6月のデータを（元帳３月）に転記し印刷できればＯＫです。
  宜しくお願いします。

    補足日時：2018/01/10 17:44

• 

  GooUserラック様
  ご連絡ありがとうございます。
  質問しても宜しいでしょうか？
  ①『元帳』シートは１ページ分（1～29行）の設定でよろしいでしょうか？また『元帳template（列Ａ～ＡＯ）』と『元帳（12・3月）Ａ～ＡＦ』の列数の違いや列幅の違いがございますが、デフォルトとして『元帳template（列Ａ～ＡＯ）』の書式に設定しておき12月印刷時は12月、３月印刷時は3月用templateを『元帳』シートに設定しておけばよろしいということでしょうか？　
  宜しくお願い致します。(*^_^*)

  No.12の回答に寄せられた補足コメントです。 補足日時：2018/01/11 11:10

No.1 回答者： GooUserラック 回答日時： 2018/01/09 13:17

念の為の確認です。

「1～29行を１ページとしています。以降２ページ＝30行～５９行を繰り返すイメージ」は「1～29行を１ページとしています。以降２ページ＝30行～58行を繰り返すイメージ」の間違えですよね？

この回答へのお礼

ご連絡ありがとうございます。
私の間違いです。
ご指摘ありがとうございます
本来であれば、作付DATAや元帳シートの画像添付が一番ご理解しやすいのだと思いますが、添付すると文字が小さすぎて見えなくなってしまうのでこのような形になってしまいました。

お礼日時：2018/01/09 14:15

No.2 回答者： GooUserラック 回答日時： 2018/01/10 00:48

動作の説明が少なく、前回の物を見る事も出来ないので抜けていたり勘違いしているかもしれませんのでコピーしたファイルでお試しください。

--------------------------------------------------------------------------------
Option Explicit

Sub 元帳作成()
Const Str_元シート As String = "作付調査Data"
Const Str_先シート As String = "元帳Template"
Dim Lng_仮想頁 As Long
Dim Lng_仮想行 As Long
Dim Lng_元行 As Long
Dim Lng_先行 As Long
Dim Day_月 As Date
Dim Lng_先列 As Long
Dim Boo_タイトル As Boolean
Dim Var_データ As Variant
Dim Lng_合計 As Long
Sheets(Str_先シート).Select
Cells.ClearContents
Lng_元行 = 2
With Sheets(Str_元シート)
Do While Trim(.Cells(Lng_元行, 1).Value) <> ""
If .Cells(Lng_元行, 1).Value <> .Cells(Lng_元行 - 1, 1).Value Then
If Boo_タイトル = False Then
Lng_仮想頁 = Lng_仮想頁 + 1
Boo_タイトル = True
End If
End If
'↓↓↓↓↓タイトル行処理↓↓↓↓↓
If Boo_タイトル Then
Lng_先行 = (Lng_仮想頁 - 1) * 29 + 1
'年度
Cells(Lng_先行, 1).Value = .Cells(Lng_元行, 4).Value
'調査日
Cells(Lng_先行, 14).Value = .Cells(Lng_元行, 5).Value
Cells(Lng_先行, 14).NumberFormatLocal = "m/d"
Lng_先行 = Lng_先行 + 2
'生産者No
Cells(Lng_先行, 4).Value = .Cells(Lng_元行, 1).Value
'氏名
Cells(Lng_先行, 6).Value = .Cells(Lng_元行, 2).Value
'支部
Cells(Lng_先行, 13).Value = .Cells(Lng_元行, 3).Value
Lng_先行 = Lng_先行 + 3
'固定行
Cells(Lng_先行, 1) = "品種作型名"
Cells(Lng_先行, 5) = "計"
Day_月 = #7/30/2000#
For Lng_先列 = 6 To 39 Step 3
Cells(Lng_先行, Lng_先列).Value = Format(Day_月, "m月")
Cells(Lng_先行 + 1, Lng_先列).Value = "上"
Cells(Lng_先行 + 1, Lng_先列 + 1).Value = "中"
Cells(Lng_先行 + 1, Lng_先列 + 2).Value = "下"
Day_月 = Day_月 + 30 '本当は「DateAdd」を使った方が判りやすいかも…
Next
Lng_先行 = Lng_先行 + 2
Boo_タイトル = False
End If
'↑↑↑↑↑タイトル行処理↑↑↑↑↑
'↓↓↓↓↓データ処理↓↓↓↓↓
'品種Code
Cells(Lng_先行, 1).Value = .Cells(Lng_元行, 6).Value
Lng_先行 = Lng_先行 + 1
'品種名
Cells(Lng_先行, 1).Value = .Cells(Lng_元行, 7).Value
'月
Lng_合計 = 0
For Lng_先列 = 6 To 41
'各月の数量がゼロのときは空欄にする
If .Cells(Lng_元行, Lng_先列 + 2).Value = 0 Then
Var_データ = ""
Else
Var_データ = .Cells(Lng_元行, Lng_先列 + 2).Value
Lng_合計 = Lng_合計 + Var_データ
End If
Cells(Lng_先行, Lng_先列).Value = Var_データ
Next
'計
Cells(Lng_先行, 5) = Lng_合計
'次の行へ
Lng_先行 = Lng_先行 + 1
'↑↑↑↑↑データ処理↑↑↑↑↑
'↓↓↓↓↓最終行処理↓↓↓↓↓
If Lng_先行 Mod 29 = 1 Then
Lng_仮想頁 = Lng_仮想頁 + 1
Boo_タイトル = True
End If
'↑↑↑↑↑最終行処理↑↑↑↑↑
'次の行へ
Lng_元行 = Lng_元行 + 1
Loop
End With
MsgBox "終了"
End Sub
--------------------------------------------------------------------------------
※ プログラムを１つにまとめたので流れが判りやすくなったのでは？

この回答へのお礼

おはようございます。
早速試してみます。
ありがとうございます。（*^_^*）

お礼日時：2018/01/10 09:12

No.3 回答者： GooUserラック 回答日時： 2018/01/10 09:48

No.2 の補足

「Cells.ClearContents」で毎回最初に「元帳Template」シートを書式のみ残してクリアしています。もし計算式など有るようでしたらそれもクリアされてしまいます。
計算式などを残したいのならば１ブロック（１行目～２９行目）が初期化されている「原紙」シートを作り、それを必要な回数コピーするようなことが一番簡単です。
もちろん原紙シートはこちらでは作れませんのでお任せしますが、コードの修正は数行で済みますので必要ならば言ってください。

この回答へのお礼

GooUserラック様
出来ました（*^_^*）
まさに思い描いていた通りのものができています。
実は４月締めの花卉専門農協です。
上司に作れと言われ教材を見たりネットで調べたりいろいろ試行錯誤していましたが
なかなか応用できるものがなくて困っていました・・・一週間かけてもまだできないのかと上司に暴言を吐かれたりもしました・・・
GooUserラック様のおかげでストレスがなくなりました。
ちょっとネックなのは顧客が500人いるので一人当たりの平均レコード数約20あり
２枚印刷すると仮定しただけで元帳Tamplateシートに1000以上の書式を作らないといけません。その作業にかなりの時間を要することです。（1～29行＝1印刷なのでもとになる様式を永遠とコピーしていくつもりですがもっと効率よくできる方法ございますでしょうか？）
GooUserラック様がおっしゃっております原紙（1～29行の書式）を作れば解決するのでしょうか？実際に毎回印刷する際は1000枚以上印刷していたと思います。

さらに・・実は１２月と３月は”上”中”下”から”上1”上2”中1”中2”下1”下2”の６段階に切り替えないといけない時期があります・・・

教えて頂けないでしょうか。宜しくお願い致します。

お礼日時：2018/01/10 10:55

No.4 回答者： GooUserラック 回答日時： 2018/01/10 10:03

No.3 の補足

「原紙」シートを作ると書式設定やタイトルの部分を毎回作り直す必要が無くなるので効率の点でも良いと思いますし、管理修正の事を考えても１ブロックさえ直せば済むので本当におすすめですよ！

ここからは、ただの興味本位の確認なので無視されてもかまいません。
・データが７月開始という、かなり変わっていますが６月〆とかなのでしょうか？
・元のコードを見ると関数を使ったりコードが分割されていましたが、追加追加したためになってしまったのでしょうか？

この回答へのお礼

GooUserラック様
分割は追加追加したためそうなてしまいました。
ちなみに原紙に罫線を入れても大丈夫なのでしょうか？
また29行目（最終行）Ａ29に”合計”　Ｅ29～ＡＯ29まで縦計を入れることも可能ですか？
素人ですみません・・・宜しくお願い致します。

お礼日時：2018/01/10 11:07

No.5 回答者： GooUserラック 回答日時： 2018/01/10 11:23

書式コピーは原紙シートさえ作れば簡単です。

しかもプログラムの方で｢○月｣とか｢上｣｢中｣｢下｣等を書き込む必要も無くなるので１２月と３月の対応も、ただ横に列を増やすだけで済みますので本当に楽です。

あまり意味の無さそうな「一人当たりの最大行数」の制限も外してしまっていますが、問題は無いのでしょうか？

ところで「元帳Template」シートですが印刷してしまえば不要なのでしょうか？
不要ならば１シート分が出来たら印刷、その後上書きを繰り返せば原紙シートを作る必要もありませんし、データが増えないので軽くなると思います。
ただし任意の部分のみ印刷したいとかならば別の仕組みを作らないといけないので改良が必要です。

どんなふうにしたいか？ご意見いただけますか？

この回答へのお礼

毎年各個人データ（レコード）にかなりの変動があるので制限がないほうが助かります。
ちなみに元帳Tamplateに転記したデータを印刷してしまえばそのデータは不要になります。上書きできれば、かなりありがたいです!(^^)!
任意の部分のみ印刷することはありません。

お礼日時：2018/01/10 12:13

No.6 回答者： GooUserラック 回答日時： 2018/01/10 11:38

No.4 のお礼について

もちろん罫線もＯＫですし、計算式もＯＫなので原紙の方で縦計の計算式を入れておけば出来ます。その場合データは２７行目まで書き込めば良いのですよね？（１シートに書き込めるデータは１つずつ減りますが問題は無いでしょうか？）
縦計ですがシートごとの集計で良いのですよね？
氏名ごととなると、少し工夫が必要なのと、途中は「シート合計」最後だけ「トータル合計」で良いのでしょうか？

この回答へのお礼

ご連絡ありがとうございます。
１シートに10レコード分のデータを転記できれば問題ありません（*^_^*）
２行＝１レコードなので２７行目まで書き込めればＯＫです。
最終行は28、29行と２行使用できますので２８行目にページ小計２９行目に合計という表示ができれば助かります。２ページあれば１ページ目は小計と合計は同数になり、２ページ目の小計は２ページのみの小計にして、合計は1ページ+２ページの計が表示できれば幸いです。
実際のデータを添付いたしますのでご確認いただけると幸いです。
ちなみに塗りつぶし部分は勝手に私が固定行として追加いたしました。
http://www.taiyo-hana2.jp/wp-content/uploads/201 …

お礼日時：2018/01/10 12:07

No.7 回答者： GooUserラック 回答日時： 2018/01/10 12:48

ファイル確認しましたが、出来れば１２月と３月を追加し、小計と合計を追加した物をのせていただいた方が確認しやすいのですが、「作付調査

Data」シートも「元帳Template」シートも横に６セル増えて、「元帳Template」シートは２８行目を小計、２９行目を合計にしたもので良いのでしょうか？

この回答へのお礼

連絡が遅れて申し訳ありません。昼食中でした・・・
了解しました。至急作成してデータ送ります。
しばらくお待ちください(*^_^*)

お礼日時：2018/01/10 13:36

No.8 回答者： GooUserラック 回答日時： 2018/01/10 15:55

取り出す月によって取り出すデータの位置が変わってしまうのですね？

それでループ処理をしないで１件ずつ処理していたわけなんですね？

以下確認願います。
① １回目は作付dataの｢12月-2｣｢12月-4｣｢12月-6｣｢3月-2｣｢3月-4｣｢3月-6｣の欄には何も入っていないのでしょうか？それとも｢0｣が入っているのでしょうか？
② 取引が無い月の作付dataのデータには何も入っていないのでしょうか？それとも｢0｣が入っているのでしょうか？
③ 作付dataの印刷に使わないデータの欄を空欄、使うデータの欄は空欄が有ったら｢0｣に変更してしまっても良いですか？（こうする事によってプログラムを共通にすることが出来ます）
④ それぞれ作成する月は決まっていますか？（これが決まっていればどのパターンで元帳を作成するかを考えないで済むようになります）

No.9 回答者： GooUserラック 回答日時： 2018/01/10 16:41

これは提案ですが、生産者ごとのページ番号をどこかに書き込んだ方が良いと思うのですが…

例えば「元帳tamplate」は AA1～AO1 をセル結合「元帳（12月）」と「元帳（3月）」は AA1～AF1 をセル結合して、そこに「No.1001-1」のように書き込んだら良いかと（書式設定は右詰めでフォントの下線ありにされると良いかと）
なお結合するセルの一番左は同じセルにしてください。

No.10 回答者： GooUserラック 回答日時： 2018/01/10 17:00

No.8への補足コメントについて

③ 元々印刷シートの方は「0」を全て空欄に変更する仕様でしたよね？そこは変わりません。
④ ではこの処理をした月によって以下のように処理しても問題ないですよね？
処理月が6月～11月は通常版、処理月が12月～2月は12月版、処理月が3月～5月は3月版を使う事でよろしいですか？