Excel VBA質問箱 IV

当質問箱は、有志のボランティア精神のおかげで成り立っています。
問題が解決したら、必ずお礼をしましょうね。
本サイトの基本方針をまとめました。こちら をご一読ください。

投稿種別の選択が必要です。ご注意ください。
迷惑投稿防止のため、URLの入力を制限しています。ご了承ください。


4565 / 13644 ツリー ←次へ | 前へ→

【55890】差し込み印刷をしたい PON 08/5/22(木) 12:13 質問[未読]
【55907】Re:差し込み印刷をしたい りん 08/5/23(金) 4:38 回答[未読]
【55908】Re:差し込み印刷をしたい PON 08/5/23(金) 8:45 お礼[未読]

【55890】差し込み印刷をしたい
質問  PON  - 08/5/22(木) 12:13 -

引用なし
パスワード
   過去スレ等も見たのですが、まったく同じと思えるようなものがなくVBA初心者のためわかりませんでした。仕事上必要ですのでどなたか教えてください(._.)

たくさんデータが入力されたシート「一覧表」があるとします。その中から条件を満たしたデータだけを「印刷用データ」として抽出します。
抽出したデータを様式に差し込み印刷したいのです。

*1枚に印刷できるデータは4件です。
*「印刷用データ」に抽出されて出てきたデータが4件以上になった場合も、様式を初期化(空白)にして続けて差し込み印刷したいです。

「印刷用データ」には↓のようにデータが入っています。A列の番号は連続していません。
  A  B   C   D   E
1] 番号 名前 日付 用務 時間
2] 3  あ  い  う  え
3] 5  か  き  く  け
4] 6  さ  し  す  せ
5] 9  た  ち  つ  て

差し込み印刷したい様式は↓でA11、A19、A27、A35に印刷用データのA列の番号が入れば他の項目はVLOOKUP関数で表示されるようになっています。
  A   B  C   D   E
1]

9]
10]
11] 3
12]

18]
19] 5
20]

26]
27] 6
28]

34]
35] 9
36]

すみませんが、教えてください(._.)よろしくお願いします。
  

【55907】Re:差し込み印刷をしたい
回答  りん E-MAIL  - 08/5/23(金) 4:38 -

引用なし
パスワード
   PON さん、おはようございます。

>*1枚に印刷できるデータは4件です。
>*「印刷用データ」に抽出されて出てきたデータが4件以上になった場合も、様式を初期化(空白)にして続けて差し込み印刷したいです。

>「印刷用データ」には↓のようにデータが入っています。A列の番号は連続していません。
>   A  B   C   D   E
>1] 番号 名前 日付 用務 時間
>2] 3  あ  い  う  え
>3] 5  か  き  く  け
>4] 6  さ  し  す  せ
>5] 9  た  ち  つ  て
>
>差し込み印刷したい様式は↓でA11、A19、A27、A35に印刷用データのA列の番号が入れば他の項目はVLOOKUP関数で表示されるようになっています。

A列のセルの値は不連続でも行番号は連続のようですので、4つ飛ばすごとに印刷するようにしました。

Sub test()
  Dim ws(1 To 2) As Worksheet, RR&, Rpos&, NN&
  'このマクロのブックが対象です
  With ThisWorkbook
   Set ws(1) = .Worksheets("Sheet1") 'リストのシートをセット
   Set ws(2) = .Worksheets("Sheet2") '印刷するシートをセット
  End With
  '
  '最下行計算(そこまでは連続で入ってるとして処理します)
  With ws(1)
   Rmax = .Cells(.Rows.Count, "A").End(xlUp).Row
  End With
  For RR& = 2 To Rmax
   NN& = (RR& - 2) Mod 4 + 1 '1,2,3,4
   '11,19,27,35 →3に8ずつ足していけばいい
   ws(2).Cells(NN& * 8 + 3, "A").Value = ws(1).Cells(RR&, "A").Value
   If NN& = 4 Or RR& = Rmax Then
     If NN& < 4 Then
      '最下行の場合は入っていないセルがあればクリアして印刷
      For II& = NN& + 1 To 4
        ws(2).Cells(II& * 8 + 3, "A").ClearContents
      Next
     End If
     Application.Calculate '念のため再計算
     ws(2).PrintOut from:=1, To:=1, copies:=1 '印刷
   End If
  Next
  '終了
  Erase ws
End Sub

こんな感じです。

【55908】Re:差し込み印刷をしたい
お礼  PON  - 08/5/23(金) 8:45 -

引用なし
パスワード
   朝早くから回答いただきありがとうございます☆

教えていただいたとおり入力したら印刷できました☆ありがとうございました☆

4565 / 13644 ツリー ←次へ | 前へ→
ページ:  ┃  記事番号:
2610219
(SS)C-BOARD v3.8 is Free