悩んでくれる方募集中！(コード掲載)

質問

いままで4月という名のシートの「A列」のランダムな位置に数字の[ 1 ]を数カ所とびとびで入力して列を選択した場合、選択した列に入っている行データーを合計請求書シートにあてはめて印刷しておりました。（下記コード使用）
悩みですが、プリント（プレビューでも可）したという証に[ 1 ]を入力していたセルに[ 1 ]を消して紫の色を付けたいのですが可能でしょうか。
又、1月から12月までシートと印刷用合計請求書シートからなるブックなのですが、月ごとに下記のコードの月表示のみ変更してコピーして使用しているため、12コードある状態です。
もっとスマートなコードおしえていただけないでしょうか。
よろしくお願いいたします。

Sub 合計請求書印刷4月()
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("W15").Value = Sheet1.Cells(i, 10).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("W32").Value = Sheet1.Cells(i, 10).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("W49").Value = Sheet1.Cells(i, 10).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("W49").Value = ""
Sheet2.Range("G49").Value = ""

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

End If

Sheet2.PrintPreview
End If

Set Sheet2 = Nothing
Set Sheet1 = Nothing

End Sub

回答No.1

onnobu · ベストアンサー

実行環境がないので試していませんが、参考程度にして下さい。

シート名の列定義を配列にセットすれば短くなると管理しやすくなると思います。

例.)
Select Case j Mod 3の処理の変わりに

Dim RangeCol() As String = New String(){
"W42", "B49", "W49", "G49", // j Mod 3 = 0
"W8", "B15", "W15", "G15", // j Mod 3 = 1
"W25", "B32", "W32", "G32" // j Mod 3 = 2
}
Dim m As Integer = j Mod 3
Dim k As Integer
Dim Col() As int = new Integer(){
2, 8, 10, 9
}

For k = 0 To 3
Sheet2.Range(RangeCol((m << 2) + k)).Value = Sheet1.Cells(i, Col(k)).Value
Next

うる覚えですがWorksheetにBackGroundというメソッドがあったと思います。
BackGroundにセットしたい色を指定すれば色は変わると思います。

お礼

参考にさせていただきます。貴重なお時間ありがとうございます。

回答No.2

redfox63

合計請求処理マクロは1つでよさそうです

請求元のシート(またはシート名)を引数にして呼び出せばいいように思います

Sub 合計請求諸印刷(Worksheet oSrc)
End Sub
といった具合に宣言しておいて

Sheet2の印刷処理を呼び出す際に
　　合計請求印刷 Sheet2
などといった具合に使います

実際の コード上では Sheet2などの請求条件等を取得するシートオブジェクトを 引数の oSrcに変更します
セルを塗りつぶす場合は Rangeオブジェクトの interior.indexColorに希望の色情報を設定しましょう
マゼンタ(紫)なら 7を設定します

お礼

参考にさせていただきます。貴重なお時間ありがとうございます。