ExcelのVBAで。

質問

BOOK1とBOOK2にそれぞれ表があります。

例としてBOOK1には

No　｜　商品名　｜　値段　｜　品番
1　 ｜　みかん　｜　　80　｜　11111
2　 ｜　りんご　｜　 100　｜　22222
とあり、
「No」と「枚数」を入力してボタンを押すと、
BOOK2に情報を反映させるといった形です。

BOOK2の方の表は、BOOK1と同じですが、全部で表が3枚あり、
それぞれに反映させたあと、印刷させます。
「枚数」が1枚ならそのまま反映させればいいのですが、
2枚以上になると、品番の最後にアルファベットをつけなくてはならないのです。
例えば、「No=1」「枚数=3」とした場合には、
1　｜　みかん　｜　80　｜　11111A
というものを反映させ印刷させたあと、
1　｜　みかん　｜　80　｜　11111B
とし、さらに印刷をし、また
1　｜　みかん　｜　80　｜　11111C
として印刷をして完了です。

これをどのようにしてやっていいのかまったくわかりません。
Accessのコードなら触ったことがあるのですが、Excelは今回が
ほとんどはじめてといっていいです。
マクロも自動で組むことができるくらいです。

ぜひお願いします。

# わからないことがあったら補足しますので、要求お願いします。

回答No.2

nishi6 · ベストアンサー

補足を反映してみました。
『全部で表が３枚あり』と『２枚以上になると』の『枚』は違う意味なんですね。
　『全部で表が３枚あり』・・・絶対３枚ある。
　『２枚以上になると』・・・・３枚セットを何回印刷するか　と解釈しました。

Sub printBook2()
　　'*** Book、Sheetを定義する ***
　　Dim wb1 As Workbook 'Book1
　　Dim ws11 As Worksheet 'Book1のSheet1
　　　　Set wb1 = ThisWorkbook
　　　　Set ws11 = wb1.Worksheets("Sheet1")
　　Dim wb2 As Workbook 'Book2
　　Dim ws21 As Worksheet 'Book2のSheet1
　　　　Set wb2 = Workbooks("Book2.xls")
　　　　Set ws21 = wb2.Worksheets("Sheet1")

　　'*** 入力No.に該当する行を特定する ***
　　Dim iNo As Integer '入力したNo
　　Dim fndRg As Range '入力したNoを検索した結果セル
　　iNo = ws11.Range("inpNo")
　　Set fndRg = ws11.Range("A:A").Find(what:=iNo, LookAt:=xlWhole)
　　　　'入力No.が見つからなければ終わり
　　　　If fndRg Is Nothing Then
　　　　　　MsgBox "該当No.はありません。"
　　　　　　Exit Sub
　　　　End If

　　'*** 入力No.が見つかれば ***
　　Dim iMaisuu As Integer '入力した枚数
　　Dim pg As Integer 'カウンタ
　　Dim alph As String '品番に付けるアルファベット
　　'枚数のチェックはしない。多分『Z』は超えないだろう
　　iMaisuu = ws11.Range("inpMaisuu")

　　'*** Book2へ書き出す ***
　　'例として、Book2のSheet1の、
　　'　　B4に『No.』、C4に『商品名』、D4に『値段』、E4に『品番』を表示
　　'　　B9に『No.』、C9に『商品名』、D9に『値段』、E9に『品番』を表示
　　'　　B14に『No.』、C14に『商品名』、D14に『値段』、E14に『品番』を表示
　　'　　表題は既にあるものとする

　　'*** 品番以外の項目をBook2のSheet1に転記する ***
　　With ws21
　　　　.Range("B4") = fndRg.Offset(0, 0)
　　　　.Range("C4") = fndRg.Offset(0, 1)
　　　　.Range("D4") = fndRg.Offset(0, 2)
　　　　.Range("B9") = fndRg.Offset(0, 0)
　　　　.Range("C9") = fndRg.Offset(0, 1)
　　　　.Range("D9") = fndRg.Offset(0, 2)
　　　　.Range("B14") = fndRg.Offset(0, 0)
　　　　.Range("C14") = fndRg.Offset(0, 1)
　　　　.Range("D14") = fndRg.Offset(0, 2)
　　　　For pg = 1 To iMaisuu
　　　　　　'*** 品番に付けるアルファベットを決める ***
　　　　　　If iMaisuu > 1 Then
　　　　　　　　alph = Chr(64 + pg)
　　　　　　End If
　　　　　　'*** 項目をBook2のSheet1に転記する ***
　　　　　　.Range("E4") = fndRg.Offset(0, 3) & alph
　　　　　　.Range("E9") = fndRg.Offset(0, 3) & alph
　　　　　　.Range("E14") = fndRg.Offset(0, 3) & alph
　　　　　　'今はプレビュー （ .PrintOut で印刷 ）
　　　　　　.PrintPreview '.PrintOut
　　　　Next
　　End With
End Sub

お礼

＞『全部で表が３枚あり』と『２枚以上になると』の『枚』は違う意味なんですね。
＞　『全部で表が３枚あり』・・・絶対３枚ある。
＞　『２枚以上になると』・・・・３枚セットを何回印刷するか　と解釈しました。

はい、その通りです！
つたない説明でおわかりいただけて嬉しいです。

教えていただいたコードを参考に、自分でちょっと変更を加えて（ファイル名とか
シート名とか）やってみたところ無事できました！！
ありがとうございました！！

また何かわからないことがあったらお願いします。

本当にありがとうございました。

回答No.1

nishi6

質問にある手順を作ってみました。
Book2の３枚の表はSheet1、Sheet2、Sheet3に１枚ずつあるとしました。
Book1のデータをどのようにBook2にセットするか不明なため、Book2のSheet1、Sheet2、Sheet3のB4～E4に書き込むようにしています。
処理モデルと思って下さい。基本的な処理の流れがつかめればと思います。

マクロを書くやすくするためにBook1のSheet1に『No.』と『枚数』をセットするセルを定義します。
シートの左上の名前ボックスを使って、
　　Sheet1の『No.』　を入力するセルに『inpNo』
　　Sheet1の『枚数』を入力するセルに『inpMaisuu』　の名前を付けます。
このセルをマクロで読み込みます。別方法として、InputBoxを使ったりすることもできます。

ツール→マクロ→Visual Basic Editor でVBE画面に移り、挿入→標準モジュール で標準モジュールを挿入します。でてきたコードウインドウに下記マクロをコピーして貼り付けます。
Book1とBook2を開いた状態にします。Book1のSheet1で『No.』と『枚数』をセットして、ツール→マクロ→マクロ でprintBook2 を実行します。

ここから
↓
Sub printBook2()
　　'*** Book、Sheetを定義する ***
　　Dim wb1 As Workbook 'Book1
　　Dim ws1 As Worksheet 'Book1のSheet1
　　　　Set wb1 = ThisWorkbook
　　　　Set ws1 = wb1.Worksheets("Sheet1")
　　Dim wb2 As Workbook 'Book2
　　　　Set wb2 = Workbooks("Book2.xls")

　　'*** 入力No.に該当する行を特定する ***
　　Dim iNo As Integer '入力したNo
　　Dim fndRg As Range '入力したNoを検索した結果セル
　　iNo = ws1.Range("inpNo")
　　Set fndRg = ws1.Range("A:A").Find(what:=iNo, LookAt:=xlWhole)
　　　　'入力No.が見つからなければ終わり
　　　　If fndRg Is Nothing Then
　　　　　　MsgBox "該当No.はありません。"
　　　　　　Exit Sub
　　　　End If

　　'*** 入力No.が見つかれば ***
　　Dim iMaisuu As Integer '入力した枚数
　　Dim pg As Integer 'カウンタ
　　Dim alph As String '品番に付けるアルファベット
　　iMaisuu = ws1.Range("inpMaisuu")
　　　　'枚数のチェック
　　　　If Not (iMaisuu = 1 Or iMaisuu = 2 Or iMaisuu = 3) Then
　　　　　　MsgBox "入力した枚数が不正です。"
　　　　　　Exit Sub
　　　　End If

　　'*** Book2へ書き出す ***
　　'例として、Book2の各シートの、
　　'　　B4に『No.』、C4に『商品名』、D4に『値段』、E4に『品番』を表示
　　For pg = 1 To iMaisuu
　　　　'*** 品番に付けるアルファベットを決める ***
　　　　If iMaisuu > 1 Then
　　　　　　alph = Chr(64 + pg)
　　　　End If
　　　　'*** 項目をBook2に転記する ***
　　　　With wb2.Worksheets("Sheet" & pg)
　　　　　　.Range("B4") = fndRg.Offset(0, 0)
　　　　　　.Range("C4") = fndRg.Offset(0, 1)
　　　　　　.Range("D4") = fndRg.Offset(0, 2)
　　　　　　.Range("E4") = fndRg.Offset(0, 3) & alph

　　　　　　'今はプレビュー （ .PrintOut で印刷 ）
　　　　　　.PrintPreview '.PrintOut
　　　　End With
　　Next
End Sub

補足

回答ありがとうございます。

説明不足にもかかわらずだいぶ希望に近いものができています。
本当にお礼申し上げます。

説明不足であったところを補足させていただいてもよろしいでしょうか？

まず、Book2にデータをはきだす形式としては、同じシート上（例えばSheet1）
に3つの表があって、そこへデータを表示したいのです。
（表はほぼ同じ形状のものが3つ続いていて、それぞれ表の終わりで
改ページが設定してあり、印刷結果は3枚になる。）
でもこれは教えていただいたコードをもとに自分で改造すればなんとかなりそうです。

問題はもう一つです。
教えていただいたものは「枚数」に2と入力数とsheet1に品番にAがつくもの、
sheet2に品番にBがつくものを出していただきましたが、
これもやはりsheet1に出したいのです。

状態としては
（Noが1で枚数が2の場合・同じSheet1上）
【表1】
No　｜　商品名　｜　値段　｜　品番
1　 ｜　みかん　｜　80　　｜　11111A

【表2】
No　｜　商品名　｜　値段　｜　品番
1　 ｜　みかん　｜　80　　｜　11111A

【表3】
No　｜　商品名　｜　値段　｜　品番
1　 ｜　みかん　｜　80　　｜　11111A

と表示され、印刷もされ、その後勝手に
【表1】
No　｜　商品名　｜　値段　｜　品番
1　 ｜　みかん　｜　80　　｜　11111B

【表2】
No　｜　商品名　｜　値段　｜　品番
1　 ｜　みかん　｜　80　　｜　11111B

【表3】
No　｜　商品名　｜　値段　｜　品番
1　 ｜　みかん　｜　80　　｜　11111B
と更新され、また勝手に印刷を行う、という動作が
ボタンのクリックひとつでできないでしょうか？

宜しくお願いします。