VBEのコードを載せました。何処が間違っているのですか。教えてくださいよろしくお願いいたします。

質問

印刷用紙のひな形がA4の紙のなかに3段になっています。

「sheet4月」は顧客名(B行)、担当者名、他に月の売上金等が並んでい

ます。顧客名の横の空白のA行に数字の1を入れて、顧客列を選択しま

す。それを「sheet合計請求書」に各項目をあてはめて印刷したいので

す。

下記のVBEのコードでは「sheet4月」で選択の顧客が「合計請求書」に

内容が移ると3段とも同じ内容、名前になります。

例えば上から1段目「H商事」、2段目「H商事」、3段目「H商事」といっ

た具合です。

それを、3段とも違う顧客の内容にしたいのです。

例えば上から1段目、「H商事」、2段目「K機械」、3段目「V貨物」のよ

うにしたいのですがわかりません。数字の1をいれて選択する数は約40

社程度です。

ご指導お願いいたします。

Sub 合計請求書印刷()
Dim Sheet1 As Worksheet
Dim Sheet2 As Worksheet
Set Sheet1 = ThisWorkbook.Worksheets("4月")
Set Sheet2 = ThisWorkbook.Worksheets("合計請求書")
Dim baseRow As Long

' 7行目から、2列目(顧客名)が空になるまでループ
baseRow = 7
Do While (Sheet1.Cells(baseRow, 2).Value <> "")

'1列目（A列）に1が入っていた時のみ印刷
If (Sheet1.Cells(baseRow, 1).Value = 1) Then

' 1段目
Sheet2.Range("W8").Value = Sheet1.Cells(baseRow, 2).Value
Sheet2.Range("B15").Value = Sheet1.Cells(baseRow, 8).Value
Sheet2.Range("C15").Value = Sheet1.Cells(baseRow, 10).Value
Sheet2.Range("W15").Value = Sheet1.Cells(baseRow, 5).Value

' 2段目
baseRow = baseRow + 1
Sheet2.Range("W25").Value = Sheet1.Cells(baseRow, 2).Value
Sheet2.Range("B32").Value = Sheet1.Cells(baseRow, 8).Value
Sheet2.Range("C32").Value = Sheet1.Cells(baseRow, 10).Value
Sheet2.Range("W32").Value = Sheet1.Cells(baseRow, 5).Value

'3段目
baseRow = baseRow + 1
Sheet2.Range("W42").Value = Sheet1.Cells(baseRow, 2).Value
Sheet2.Range("B49").Value = Sheet1.Cells(baseRow, 8).Value
Sheet2.Range("C49").Value = Sheet1.Cells(baseRow, 10).Value
Sheet2.Range("W49").Value = Sheet1.Cells(baseRow, 5).Value

' 印刷プレビュー
Sheet2.PrintPreview
End If

baseRow = baseRow
Loop

Set Sheet2 = Nothing
Set Sheet1 = Nothing
End Sub

よろしくお願いいたします。

回答No.7

Raistlin · ベストアンサー

なるほど私の想定したコードに穴がありました。
申し訳ありません。

ただNo5の時点で、印刷する件数が3の倍数で無い場合に、最後の帳票のみ印刷できない(6件以上を印刷対象にすれば4件目以降でも印刷できる)旨書いていただければ、「4件目以降の印刷ができない」とはどういう状態の事か悩まずに済んだのですが。

ここから本題です。
印刷件数で場合分けすると、Do～Loopを抜けた時点では以下のようになっています。

印刷件数　j　　 j Mod 3　結果
3n+1　　　3n+2　2　　　　n回印刷完了している
　　　　　　　　　　　　 1段目に3n+1件目がセットされている
　　　　　　　　　　　　 2段目に3(n-1)+2件目がセットされたまま
　　　　　　　　　　　　 3段目に3(n-1)+3件目がセットされたまま
3n+2　　　3n+3　0　　　　n回印刷完了している
　　　　　　　　　　　　 1段目に3n+1件目がセットされている
　　　　　　　　　　　　 2段目に3n+2件目がセットされている
　　　　　　　　　　　　 3段目に3(n-1)+3件目がセットされたまま
3n　　　　3n+1　1　　　　n回印刷され問題ない

よって、Do～Loopを抜けた後に以下のような処理を追加すれば最後の帳票が抜ける事がなくなります。
If 「jを3で割った余りが1」 Then
　「何もしない(追加印刷が必要ない)」
Else
　「3段目の値を空白に」
　If 「jを3で割った余りが2」Then
　　「2段目の値を空白に」
　End If
　「印刷」
End If

思考の過程が重要ですので、あえて長々と書いています。
分岐があるプログラムなので、分岐条件によってどう動作が変わるか検証するのが重要な点です。
　⇒jの剰余は0/1/2の3通りあるから、3通りそれぞれを試すとどうか、プログラム上はどう動くはずか

補足

下記のようなコードにて解決いたしました。もっとスマートなコードがあるのでしょうが私の中ではこれでいっぱいです。長期にわたりご指導、お付き合い頂きありがとうございました。
又機会がありましたらよろしくお願いいたします。（もうこりました？）
Sub 合計請求書印刷()
Dim Sheet1 As Worksheet
Dim Sheet2 As Worksheet
Set Sheet1 = ThisWorkbook.Worksheets("4月")
Set Sheet2 = ThisWorkbook.Worksheets("合計請求書")
Dim baseRow As Long

' 7行目から、2列目(顧客名)が空になるまでループ
baseRow = 7
i = baseRow
j = 1
Do While (Sheet1.Cells(i, 2).Value <> "")
If (Sheet1.Cells(i, 1).Value = 1) Then

Select Case j Mod 3

Case 1
Sheet2.Range("W8").Value = Sheet1.Cells(i, 2).Value
Sheet2.Range("B15").Value = Sheet1.Cells(i, 8).Value
Sheet2.Range("Q15").Value = Sheet1.Cells(i, 10).Value
Sheet2.Range("W15").Value = Sheet1.Cells(i, 5).Value
Sheet2.Range("G15").Value = Sheet1.Cells(i, 9).Value
Case 2
Sheet2.Range("W25").Value = Sheet1.Cells(i, 2).Value
Sheet2.Range("B32").Value = Sheet1.Cells(i, 8).Value
Sheet2.Range("Q32").Value = Sheet1.Cells(i, 10).Value
Sheet2.Range("W32").Value = Sheet1.Cells(i, 5).Value
Sheet2.Range("G32").Value = Sheet1.Cells(i, 9).Value

Case 0
Sheet2.Range("W42").Value = Sheet1.Cells(i, 2).Value
Sheet2.Range("B49").Value = Sheet1.Cells(i, 8).Value
Sheet2.Range("Q49").Value = Sheet1.Cells(i, 10).Value
Sheet2.Range("W49").Value = Sheet1.Cells(i, 5).Value
Sheet2.Range("G49").Value = Sheet1.Cells(i, 9).Value
' 印刷プレビュー
Sheet2.PrintPreview

Case Sub 合計請求書印刷()
Dim Sheet1 As Worksheet
Dim Sheet2 As Worksheet
Set Sheet1 = ThisWorkbook.Worksheets("4月")
Set Sheet2 = ThisWorkbook.Worksheets("合計請求書")
Dim baseRow As Long

' 7行目から、2列目(顧客名)が空になるまでループ
baseRow = 7
i = baseRow
j = 1
Do While (Sheet1.Cells(i, 2).Value <> "")
If (Sheet1.Cells(i, 1).Value = 1) Then

Select Case j Mod 3

Case 1
Sheet2.Range("W8").Value = Sheet1.Cells(i, 2).Value
Sheet2.Range("B15").Value = Sheet1.Cells(i, 8).Value
Sheet2.Range("Q15").Value = Sheet1.Cells(i, 10).Value
Sheet2.Range("W15").Value = Sheet1.Cells(i, 5).Value
Sheet2.Range("G15").Value = Sheet1.Cells(i, 9).Value
Case 2
Sheet2.Range("W25").Value = Sheet1.Cells(i, 2).Value
Sheet2.Range("B32").Value = Sheet1.Cells(i, 8).Value
Sheet2.Range("Q32").Value = Sheet1.Cells(i, 10).Value
Sheet2.Range("W32").Value = Sheet1.Cells(i, 5).Value
Sheet2.Range("G32").Value = Sheet1.Cells(i, 9).Value

Case 0
Sheet2.Range("W42").Value = Sheet1.Cells(i, 2).Value
Sheet2.Range("B49").Value = Sheet1.Cells(i, 8).Value
Sheet2.Range("Q49").Value = Sheet1.Cells(i, 10).Value
Sheet2.Range("W49").Value = Sheet1.Cells(i, 5).Value
Sheet2.Range("G49").Value = Sheet1.Cells(i, 9).Value
' 印刷プレビュー
Sheet2.PrintPreview

Case Else
End Select
j = j + 1
End If
i = i + 1

Loop

If j Mod 3 = 1 Then
End

Set Sheet2 = Nothing
Set Sheet1 = Nothing

Else
Sheet2.Range("W42").Value = "<>"
Sheet2.Range("B49").Value = "<>"
Sheet2.Range("Q49").Value = "<>"
Sheet2.Range("W49").Value = "<>"
Sheet2.Range("G49").Value = "<>"

If j Mod 3 = 2 Then
Sheet2.Range("W25").Value = "<>"
Sheet2.Range("B32").Value = "<>"
Sheet2.Range("Q32").Value = "<>"
Sheet2.Range("W32").Value = "<>"
Sheet2.Range("G32").Value = "<>"

End If

Sheet2.PrintPreview
End If

Set Sheet2 = Nothing
Set Sheet1 = Nothing

End Sub

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

回答No.6

Raistlin

超能力者ではないので実際のものを見ずに答える事は不可能です。

＞どんどん合計請求書に上書きされてもかまいません。

もちろんそのつもりで作っています。
お願いですから、どういうコードを作っているのか理解してから前に進んでください。

補足

おそまつな私で申し訳ありません。
現段階でのコードを載せてみましたがなんとかおつきあいお願い致します。
現在出来ないで悩んでいること。
4件目以降のプレビューがみれないのでLoopの下に「Sheet2.PrintPreview」をいれることで解決したが、3件分で1枚の用紙のため、例えば1～7件目までの印刷には7件目の印刷のページになると、前ページの5件目、6件目のデーターがが残っていてそのまま7件目と一緒にプリントされてしまいます。1件目、2件目、3件目で1枚プリント。4件目、5件目、6件目で1枚プリント。7件目と下段2段は空白にしたいのです。そうしないと5件目、6件目が2回づつプリントされてしまってます。本当によろしくお願いいたします。

Sub 合計請求書印刷()
Dim Sheet1 As Worksheet
Dim Sheet2 As Worksheet
Set Sheet1 = ThisWorkbook.Worksheets("4月")
Set Sheet2 = ThisWorkbook.Worksheets("合計請求書")
Dim baseRow As Long

' 7行目から、2列目(顧客名)が空になるまでループ
baseRow = 7
i = baseRow
j = 1
Do While (Sheet1.Cells(i, 2).Value <> "")
If (Sheet1.Cells(i, 1).Value = 1) Then

Select Case j Mod 3

Case 1
Sheet2.Range("W8").Value = Sheet1.Cells(i, 2).Value
Sheet2.Range("B15").Value = Sheet1.Cells(i, 8).Value
Sheet2.Range("Q15").Value = Sheet1.Cells(i, 10).Value
Sheet2.Range("W15").Value = Sheet1.Cells(i, 5).Value
Sheet2.Range("G15").Value = Sheet1.Cells(i, 9).Value
Case 2
Sheet2.Range("W25").Value = Sheet1.Cells(i, 2).Value
Sheet2.Range("B32").Value = Sheet1.Cells(i, 8).Value
Sheet2.Range("Q32").Value = Sheet1.Cells(i, 10).Value
Sheet2.Range("W32").Value = Sheet1.Cells(i, 5).Value
Sheet2.Range("G32").Value = Sheet1.Cells(i, 9).Value

Case 0
Sheet2.Range("W42").Value = Sheet1.Cells(i, 2).Value
Sheet2.Range("B49").Value = Sheet1.Cells(i, 8).Value
Sheet2.Range("Q49").Value = Sheet1.Cells(i, 10).Value
Sheet2.Range("W49").Value = Sheet1.Cells(i, 5).Value
Sheet2.Range("G49").Value = Sheet1.Cells(i, 9).Value
' 印刷プレビュー
Sheet2.PrintPreview

Case Else
End Select
j = j + 1
End If
i = i + 1

Loop
Sheet2.PrintPreview　(いれてみた)
End

Set Sheet2 = Nothing
Set Sheet1 = Nothing
End Sub

回答No.5

Raistlin

「jを3で割った余り」は
j Mod 3
です。

補足

本当にありがとうございます。あきれさせて申し訳ありませんでした。

　ただ3件分のプレビューとプリントは出来るのですが3件目以降のプレビューとプリントが出来ないのです。どんどん合計請求書に上書きされてもかまいません。

ご教授お願いいたします。

回答No.4

Raistlin

3の補足の添削です。
1. Do Loop の間の複数のbaseRowをiに変え忘れています。

2. 「jを3で割った余り」を単にjとしています。

3. Case #の中身の行が途中で切れている。

4. End Ifを挿入する位置を間違えている。
　 正しくは、j = j+1、End If、i = i +1の順です。

VBAでのコードでどう書くかというレベルの前に、人間がやる時はどういう風にやるのか、落ち着いてもう一度考え直してください。

補足

おつきあいくださりありがとうございます。
早速ですが
「jを3で割った余り」はどのようにしてよいのかがわからないのですが。
よろしくお願いいたします。

回答No.3

Raistlin

＞ とjには例えばどのような数字を入れたら良いのか

前提と書いたのがまずかったんですかね。
iとjを使ってDo～Loopをまわすようなコードにしますという説明です。

実際のコードは i = baserow 以降ですが、私の書いた案でiまたはjと書いているところは、iまたはjという変数のまま使います。

Do～Loopのループが進むとi,jがどのように増えていくか、紙の上/頭の中で考えてみてください。

補足

ご教授ありがとうございます。
下記のようにあてはめてみたのですが
[end ifに対するIFブロックがありません。]とエラーがでてしまいます。私なりに調べてみるのですがわかりません。
再度ご教授お願いいたします。

Sub 合計請求書印刷()
Dim Sheet1 As Worksheet
Dim Sheet2 As Worksheet
Set Sheet1 = ThisWorkbook.Worksheets("4月")
Set Sheet2 = ThisWorkbook.Worksheets("合計請求書")
Dim baseRow As Long

' 7行目から、2列目(顧客名)が空になるまでループ
baseRow = 7
i = baseRow
j = 1
Do While (Sheet1.Cells(baseRow, 2).Value <> "")
If (Sheet1.Cells(baseRow, 1).Value = 1) Then
Select Case j
Case 1
Sheet2.Range("W8").Value = Sheet1.Cells(baseRow,
Sheet2.Range("B15").Value = Sheet1.Cells(baseRow,
Sheet2.Range("C15").Value = Sheet1.Cells(baseRow,
Sheet2.Range("W15").Value = Sheet1.Cells(baseRow,
Case 2
Sheet2.Range("W25").Value = Sheet1.Cells(baseRow,
Sheet2.Range("B32").Value = Sheet1.Cells(baseRow,
Sheet2.Range("C32").Value = Sheet1.Cells(baseRow,
Sheet2.Range("W32").Value = Sheet1.Cells(baseRow,
Case 0
Sheet2.Range("W42").Value = Sheet1.Cells(baseRow,
Sheet2.Range("B49").Value = Sheet1.Cells(baseRow,
Sheet2.Range("C49").Value = Sheet1.Cells(baseRow,
Sheet2.Range("W49").Value = Sheet1.Cells(baseRow,
' 印刷プレビュー
Sheet2.PrintPreview
End If

Case Else
End Select
j = j + 1
i = i + 1
Loop

Set Sheet2 = Nothing
Set Sheet1 = Nothing
End Sub

よろしくお願いいたします。

回答No.2

tarinko_06

答えるにあたってまずはっきりと条件を明確にしないと
答えが出にくいと思うのですが。
単純にＡ列に１が入っているデータだけを１・２・３段目に
セットするのか、それともＡ列に１が入っていない顧客でも
２・３段目にセットしていいのか。
今のままのコードだと１が入っていないデータもセットされます。
それとも、最初に１が見つかった所から３行を１セットでいいのですか？

あくまで予想なんですけど
各顧客毎のデータが連続で固まって並んでいる表に対して
最初の１個だけ手動で１を入力していったとかそんなんじゃないんですか？
それだったら今のコードで同じのが出るのも納得できるんですが。
↓みたいな感じで。

　　Ａ　　Ｂ　　 Ｃ　 Ｄ　　Ｅ　　Ｆ　　…　…　…
７　１　Ｈ商事　○○　××　△△　■■　 …　…　…
８　　　Ｈ商事　○○　××　△△　■■　 …　…　…
９　　　Ｈ商事　○○　××　△△　■■　 …　…　…
10　　　Ｈ商事　○○　××　△△　■■　 …　…　…
11　　　Ｈ商事　○○　××　△△　■■　 …　…　…
12　　　Ｈ商事　○○　××　△△　■■　 …　…　…
13　１　Ｋ機械　●●　△△　▼▼　□□　 …　…　…
14　　　Ｋ機械　●●　△△　▼▼　□□　 …　…　…

とりあえず２段目と３段目にいれる顧客の条件をはっきりと書いてください。
違う名前にしたいと言ってますが、それではコードのロジックと
矛盾しています。どっちが本当なのですか？
何が必要で何が不必要なのかがわかりかねます。

補足

ありがとうございます。詳細説明不足でわずらわして申し訳ありません。
はじめに書き入れて頂いた通り
「単純にＡ列に１が入っているデータだけを１・２・３段目に
セットする」で考えております。書き入れていただいた表でいうと

　　Ａ　　Ｂ　　 Ｃ　 Ｄ　　Ｅ　　Ｆ　　…　…　…
７　１　Ｈ商事　○○　××　△△　■■　 …　…　…
８　　　Ｈ商事　○○　××　△△　■■　 …　…　…
９　　　Ｈ商事　○○　××　△△　■■　 …　…　…
10　 1 Ｈ商事　○○　××　△△　■■　 …　…　…
11　　　Ｈ商事　○○　××　△△　■■　 …　…　…
12　　　Ｈ商事　○○　××　△△　■■　 …　…　…
13　１　Ｋ機械　●●　△△　▼▼　□□　 …　…　…
14　 1 Ｋ機械　●●　△△　▼▼　□□　 …　…　…

7の行、10の行、13の行を合計請求書の1段目、2段目3段目へいれて
プリントしたいのです。続いて14の行・・・・と30件くらい「1」をいれた行をプリントしたいのです。
ご指導お願いいたします。

回答No.1

Raistlin

＞ 3段とも同じ内容、名前になります。

というコードにもなっていないような・・・。

分かるところから手をつけるとして、印刷対象行(A列が1)は必ず連続するのでしょうか。

する時: 行数を+1する毎にA列が1かどうかを判定する必要が無い

しない時: 2段目と3段目の記入時にA列が1かどうか判定してない

する時しない時両方: Loopの前で行数を+1していない

が気になるところです。

印刷対象行が連続しないケースで考えるとして、baserow=7 以降 loopまでを以下のように組むとよいと思います。

前提: 処理対象行をカウントアップして行くためのカウンタはiとする
　　　印刷対象行を何回処理したかのカウンタはjとする

i = baserow
j = 1
　Do While 「i行のB列が空白で無い」
　　If 「i行のA列が空白」 Then
　　　Select Case 「jを3で割った余り」
　　　　Case 1
　　　　　「1段目にi行の値を複写」
　　　　Case 2
　　　　　「2段目にi行の値を複写」
　　　　Case 0
　　　　　「3段目にi行の値を複写」
　　　　　「印刷」
　　　　Case Else
　　　End Select
　　　j = j+1
　　End If
　　i = i +1
　Loop

補足

お返事ありがとうございます。
◆"印刷対象行(A列が1)は必ず連続するのでしょうか。"の問いですが、「いいえ」連続致しません。とびとびに選択したりします。

◆"前提: 処理対象行をカウントアップして行くためのカウンタはiとする印刷対象行を何回処理したかのカウンタはjとする。"の部分のiとjには例えばどのような数字を入れたら良いのか教えてもらえないでしょうか。よろしくお願いいたします。