あなたの人生に効く作品がみつかる手書きのカード♪>>

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

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

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

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

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

  • 以降2ページ=30行~59行を繰り返すイメージです。
    30~58の間違いです。

      補足日時:2018/01/09 14:17
  • HAPPY

    大変遅くなり申し訳ございません。
    データですが年3回の調査があり3回元帳シートを印刷しないといけません。上書き希望です。
    1回目は添付データの元帳tamplate
    2回目は添付データの元帳(12月)
    3回目は添付データの元帳(3月)

    1回目は7月~6月のデータを転記※12月は作付dataの12月-1が上旬 12月-3が中旬 12月-5が下旬
    に転記となります。3月も同じです。

    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
    に転記、印刷する際、0表示のまま印刷されると厳しいです。空白にするのはそこに帳票を受け取った人が数字を手書きで書き込むためです。印刷する際にexcelのオプションでゼロ値のセルにゼロ値を表示するのチェックを外せば空白になりますか?
    ④元帳templateのパターンは3パターン(通常7~6月、12月用、3月用)のみで完全固定になります。

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

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

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

    ④についてです。
    実は1回目は6月に一斉に7~6月の一年分の調査を行い、それを作付調査dataとして入力して入力dataをtemplateに転記し帳票を印刷します。

    2回目は10月に行うのですが、一回目に出力した帳票をもとにその内容に変更がないかの調査です。変更のある個所のみ作付調査dataを修正します。2回目の調査時に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月)に転記し印刷できればOKです。

    3回目の調査時に印刷する際、修正した11月~6月のデータを(元帳3月)に転記し印刷できればOKです。
    宜しくお願いします。

      補足日時:2018/01/10 17:44
  • うれしい

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

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

A 回答 (16件中11~16件)

No.4 のお礼について



もちろん罫線もOKですし、計算式もOKなので原紙の方で縦計の計算式を入れておけば出来ます。その場合データは27行目まで書き込めば良いのですよね?(1シートに書き込めるデータは1つずつ減りますが問題は無いでしょうか?)
縦計ですがシートごとの集計で良いのですよね?
氏名ごととなると、少し工夫が必要なのと、途中は「シート合計」最後だけ「トータル合計」で良いのでしょうか?
    • good
    • 1
この回答へのお礼

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

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

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


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

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

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

どんなふうにしたいか?ご意見いただけますか?
    • good
    • 1
この回答へのお礼

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

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

No.3 の補足



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

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

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

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

No.2 の補足



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

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

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

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

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

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


--------------------------------------------------------------------------------
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
--------------------------------------------------------------------------------
※ プログラムを1つにまとめたので流れが判りやすくなったのでは?
    • good
    • 1
この回答へのお礼

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

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

念の為の確認です。


「1~29行を1ページとしています。以降2ページ=30行~59行を繰り返すイメージ」は「1~29行を1ページとしています。以降2ページ=30行~58行を繰り返すイメージ」の間違えですよね?
    • good
    • 1
この回答へのお礼

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

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

お探しのQ&Aが見つからない時は、教えて!gooで質問しましょう!

このQ&Aを見た人はこんなQ&Aも見ています


このQ&Aを見た人がよく見るQ&A

人気Q&Aランキング