マジックナンバーを排除した転記 part1
１ 転記項目が多いときにセル番号を直打ちしていると、後から修正訂正が発生したとに大変なことになる。そこで、セル番地を定数として登録してから行動する。
２ シートのイベントを使う場合、シートモジュールを使う。標準モジュールとシートモジュールを同時に使うときに定数を共有しようとすると標準モジュールにPublic Const として大量に羅列することになりプロジェクト直下で管理する定数が増えてしまう。そこで、基本的にすべてシートモジュールに押し込み、シートモジュールのConstとして処理した。
しかし、以下の大量のConstを見ると嫌な気持ちになるのでこれをどうにか修正していきたい。
３ コード
シート構成は、
入力シート１枚（左端縦方向に入力欄、その右側にデータベース部分）
出力シート2枚（電所シート（通常給紙のプリンタ設定）と電所手差しシート（プリンタを手差し設定済のもの））。帳票様式は全く一緒だが、Excelはシート毎にプリンタ設定を保存しているため、事前に手動で給紙方法を違う設定でシートを保存しておくことでプリンタや給紙方法を切り替えることを実現できる。以下では、通常給紙（白紙）と手差し給紙（色紙）を切り替えている。
シートモジュール（電所入力シート）
Option Explicit
'イベントの途中でエラーになったりステップ実行途中で抜けると、イベント発生不可のままになってしまうので、
'イベントが発生しなくなってしまったらイミディエイトウインドウで Application.EnableEvents = True とする。
'ここは電所入力シートモジュール
'電所入力シート
'入力項目のセルアドレス
Const adrs入力_集計年月 = "B2"
Const adrs入力_入力ID_呼出用 = "B３"
Const adrs入力_年分 = "C4"
Const adrs入力_台帳ER区分 = "C５"
Const adrs入力_台帳下4桁 = "C6"
Const adrs入力_バッチ下4桁 = "C7"
Const adrs入力_有還無区分 = "C8"
Const adrs入力_SKoku区分 = "C9"
Const adrs入力_件数 = "C10"
Const adrs入力_誤り有無 = "C11"
Const adrs入力_連絡日 = "C12"
Const adrs入力_回付日 = "C13"
Const adrs入力_転記実行セルの1つ下 = "C16"
Const adrs入力_文字色変更対象範囲 = "C４：C13"
'電所入力シート
'データベース部分(一旦の転記してデータを溜めておく部分)
'列記号(columnLetter）ex.F10セルの「F」のこと。
Const Cletter転記先_入力ID = "F"
Const CLetter転記先_連番 = "F"
Const CLetter転記先_印刷対象 = "G"
Const CLetter転記先_集計年月 = "H"
Const CLetter転記先_年分 = "I"
Const CLetter転記先_台帳ER区分 = "J"
Const CLetter転記先_台帳下4桁 = "K"
Const CLetter転記先_バッチ下4桁 = "L"
Const CLetter転記先_有還無区分 = "M"
Const CLetter転記先_SKoku区分 = "N"
Const CLetter転記先_件数 = "O"
Const CLetter転記先_誤り有無 = "P"
Const CLetter転記先_連絡日 = "Q"
Const CLetter転記先_回付日 = "R"
'セル番地
Const adrs転記先_データベース_基点 = "Ｆ９"
'行番号
Const RNoデータベース_タイトル行番号 = 9
Const RNoデータベース_開始行番号 = 10
'出力帳票(電所シート）
'転記先セルアドレス
Const adrs出力_年分 = "R1"
Const adrs出力_台帳ER区分 = "R2"
Const adrs出力_台帳下4桁 = "R3"
Const adrs出力_集計年 = "D14" '集計年だけ直接出力シートの該当箇所に転記
Const adrs出力_集計月 = "R4"
Const adrs出力_バッチ下4桁 = "R5"
Const adrs出力_有還無区分 = "R6"
Const adrs出力_SKoku区分 = "R7"
Const adrs出力_件数 = "R8"
Const adrs出力_誤り有無 = "R9"
Const adrs出力_連絡日 = "R10"
Const adrs出力_回付日 = "R11"
'■■■■■一括印刷ボタン■■■■■
Sub btn電子データ整理表へ転記しながら一括印刷()
Application.EnableEvents = False
'シート設定
Dim ws電所入力 As Worksheet: Set ws電所入力 = ThisWorkbook.Worksheets("電所入力")
Dim ws電所 As Worksheet: Set ws電所 = ThisWorkbook.Worksheets("電所")
Dim ws電所手差し As Worksheet: Set ws電所手差し = ThisWorkbook.Worksheets("電所手差し")
'目的：手差し用紙をセットしたか確認メッセージを表示する
'表示メッセージ内容
Dim m As String: m = ""
m = m & "マイナス(有還無区分２）は手差し給紙です。" & vbNewLine
m = m & "手差し用紙をセットしましたか？" & vbNewLine
m = m & "「印刷対象」列に〇が入っている行を印刷します。" & vbNewLine
m = m & "印刷実行しますか？" & vbNewLine
'手差し用紙をセットしていなかったら印刷をキャンセル。ボタン選択のデフォルト位置はキャンセル
If MsgBox(m, vbOKCancel + vbDefaultButton2) = vbCancel Then
MsgBox "印刷をキャンセルします"
Exit Sub
End If
'目的：転記（DB→出力用帳票へ）して印刷をループ
Dim R As Long
For R = RNoデータベース_開始行番号 To ws電所入力.Range(CLetter転記先_印刷対象 & ws電所.Rows.Count).End(xlUp).Row
'印刷対象列に〇がないときは転記と印刷をスキップする
If ws電所入力.Range(CLetter転記先_印刷対象 & R).Value <> "〇" Then GoTo continueNextFor
'Ifの中で印刷までやるとコードが長くなって嫌なので、無駄があるが両方のシートに転記しちゃってから印刷だけIfで分けた。
'出力シート_電所（通常印刷設定）へ転記
With ws電所
'転記先は集計年、転記元は集計年月なので上二桁で集計年にする
.Range(adrs出力_集計年).Value = Left(ws電所入力.Range(CLetter転記先_年分 & R).Value, 2)
'転記先は集計月、転記元は集計年月なので下二桁で集計年にする
.Range(adrs出力_集計月).Value = Right(ws電所入力.Range(CLetter転記先_年分 & R).Value, 2)
.Range(adrs出力_年分).Value = ws電所入力.Range(CLetter転記先_年分 & R).Value
.Range(adrs出力_台帳ER区分).Value = ws電所入力.Range(CLetter転記先_台帳ER区分 & R).Value
.Range(adrs出力_台帳下4桁).Value = ws電所入力.Range(CLetter転記先_台帳下4桁 & R).Value
.Range(adrs入力_バッチ下4桁).Value = ws電所入力.Range(CLetter転記先_バッチ下4桁 & R).Value
.Range(adrs出力_有還無区分).Value = ws電所入力.Range(CLetter転記先_有還無区分 & R).Value
'電所シートの丸囲みを動かすイベント実行。書き直す時間がないので過去のシートイベントを流用するため一時的にイベントをONにする。
Application.EnableEvents = True
.Range(adrs出力_SKoku区分).Value = ws電所入力.Range(CLetter転記先_SKoku区分 & R).Value
Application.EnableEvents = False
.Range(adrs入力_件数).Value = ws電所入力.Range(CLetter転記先_件数 & R).Value
.Range(adrs入力_誤り有無).Value = ws電所入力.Range(CLetter転記先_誤り有無 & R).Value
.Range(adrs出力_連絡日).Value = ws電所入力.Range(CLetter転記先_連絡日 & R).Value
.Range(adrs出力_回付日).Value = ws電所入力.Range(CLetter転記先_回付日 & R).Value
End With
'出力シート_電所（手差し印刷設定）へ転記
With ws電所手差し
'転記先は集計年、転記元は集計年月なので上二桁で集計年にする
.Range(adrs出力_集計年).Value = Left(ws電所入力.Range(CLetter転記先_年分 & R).Value, 2)
'転記先は集計月、転記元は集計年月なので下二桁で集計年にする
.Range(adrs出力_集計月).Value = Right(ws電所入力.Range(CLetter転記先_年分 & R).Value, 2)
.Range(adrs出力_年分).Value = ws電所入力.Range(CLetter転記先_年分 & R).Value
.Range(adrs出力_台帳ER区分).Value = ws電所入力.Range(CLetter転記先_台帳ER区分 & R).Value
.Range(adrs出力_台帳下4桁).Value = ws電所入力.Range(CLetter転記先_台帳下4桁 & R).Value
.Range(adrs入力_バッチ下4桁).Value = ws電所入力.Range(CLetter転記先_バッチ下4桁 & R).Value
.Range(adrs出力_有還無区分).Value = ws電所入力.Range(CLetter転記先_有還無区分 & R).Value
'電所シートの丸囲みを動かすイベント実行。書き直す時間がないので過去のシートイベントを流用するため一時的にイベントをONにする。
Application.EnableEvents = True
.Range(adrs出力_SKoku区分).Value = ws電所入力.Range(CLetter転記先_SKoku区分 & R).Value
Application.EnableEvents = False
.Range(adrs入力_件数).Value = ws電所入力.Range(CLetter転記先_件数 & R).Value
.Range(adrs入力_誤り有無).Value = ws電所入力.Range(CLetter転記先_誤り有無 & R).Value
.Range(adrs出力_連絡日).Value = ws電所入力.Range(CLetter転記先_連絡日 & R).Value
.Range(adrs出力_回付日).Value = ws電所入力.Range(CLetter転記先_回付日 & R).Value
End With
'目的：場合分けして別シートを印刷
'還なら手差し印刷
If ws電所入力.Range(CLetter転記先_有還無区分 & R).Value = 2 Then
' PrintPreviewをPintoutにすれば印刷される
ws電所手差し.PrintPreview
'還以外なら通常印刷
Else
' PrintPreviewをPintoutにすれば印刷される
ws電所.PrintPreview
End If
'印刷対象列の値を「〇」から印刷済に変更
ws電所入力.Range(CLetter転記先_印刷対象 & R).Value = "印刷済"
'Forループを１回スキップしたいときはここに飛んでくる
continueNextFor:
Next R
MsgBox "印刷要求完了"
Application.EnableEvents = True
End Sub
'■■■■■DB初期化ボタン■■■■■
'注意：ボタン登録時別シートモジュールのマクロは見えないのでシート名とモジュール名を手打ちして登録する。
Sub btn電所入力シートのDB部分クリ()
'イベント停止。changeイベントの中のtarget.valueが単一セルではなくセル「範囲」を変更するとエラーになるから。
Application.EnableEvents = False
'DB（データベース）部分初期化
Dim ws電所入力 As Worksheet: Set ws電所入力 = ThisWorkbook.Worksheets("電所入力")
ws電所入力.Range(adrs転記先_データベース_基点).CurrentRegion.Offset(1, 1).ClearContents
'目的:入力ID呼出用を入力した状態でDB部分クリアした場合に入力欄を初期化する
'入力用セルの文字色を黒に戻す
ws電所入力.Range(adrs入力_文字色変更対象範囲).Font.Color = vbBack
'入力ID呼出用セルを初期化
ws電所入力.Range(adrs入力_入力ID_呼出用).Value = ""
Application.EnableEvents = True
End Sub
'■■■■■ダブルクリックイベント■■■■■
'ダブルクリックしたセルが特定の範囲にあった場合
Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)
'ダブルクリックしたセルの列記号で場合分け
Select Case Split(Target.Address, "$")(1)
'ダブルクリックしたセルがG列だったら
Case "G"
'ダブルクリックしても編集モードにしない
Cancel = True
' ダブルクリックしたセルの値で場合分け
Select Case Target.Value
' セルの値が空欄だったら”〇”を入力
Case ""
Target.Value = "〇"
' セルの値が”〇”だったら空欄にする
Case "〇", "印刷済"
Target.Value = ""
End Select
End Select
End Sub
'■■■■■チェンジイベント■■■■■
'「入力ID呼出用」セルに数字を入力した場合
Private Sub Worksheet_Change(ByVal Target As Range)
'イベント二重起動防止
Application.EnableEvents = False
' 複数セル一括変更した場合は実行しない｡単一セルのみ｡複数セル選択時にtarget.valueがエラーとなる対策。
If Target.Count > 1 Then Exit Sub
'シート設定
Dim ws入力 As Worksheet: Set ws入力 = Me
Dim RNoデータベース_取得行番号: RNoデータベース_取得行番号 = ws入力.Range(adrs入力_入力ID_呼出用).Value + RNoデータベース_タイトル行番号
'目的：入力欄の入力ID呼出用セルに数字を入れたらDBからデータを呼び戻して訂正して転記できるようにする。
'入力ID_呼出用の値が変更された場合
With ws入力
Select Case True
'訂正のために入力ID_呼出用に数字を入れたとき（複数セル同時に変更するとtarget.valueが型エラーになってしまうのでプロシージャ冒頭で事前にExit Subで対策してある）
Case Target.Address(0, 0) = adrs入力_入力ID_呼出用 And Target.Value <> ""
'入力ID_呼出用に該当するデータをDB範囲から呼び戻す
'例）入力欄の年分セルに、データベース部分の入力IDに該当するデータを､代入する
.Range(adrs入力_集計年月).Value = .Range(CLetter転記先_集計年月 & RNoデータベース_取得行番号).Value
.Range(adrs入力_年分).Value = .Range(CLetter転記先_年分 & RNoデータベース_取得行番号).Value
.Range(adrs入力_台帳ER区分) = .Range(CLetter転記先_台帳ER区分 & RNoデータベース_取得行番号).Value
.Range(adrs入力_台帳下4桁) = .Range(CLetter転記先_台帳下4桁 & RNoデータベース_取得行番号).Value
.Range(adrs入力_バッチ下4桁) = .Range(CLetter転記先_バッチ下4桁 & RNoデータベース_取得行番号).Value
.Range(adrs入力_有還無区分) = .Range(CLetter転記先_有還無区分 & RNoデータベース_取得行番号).Value
.Range(adrs入力_SKoku区分) = .Range(CLetter転記先_SKoku区分 & RNoデータベース_取得行番号).Value
.Range(adrs入力_件数) = .Range(CLetter転記先_件数 & RNoデータベース_取得行番号).Value
.Range(adrs入力_誤り有無) = .Range(CLetter転記先_誤り有無 & RNoデータベース_取得行番号).Value
.Range(adrs入力_連絡日) = .Range(CLetter転記先_連絡日 & RNoデータベース_取得行番号).Value
.Range(adrs入力_回付日) = .Range(CLetter転記先_回付日 & RNoデータベース_取得行番号).Value
'訂正入力中であることを表示するため、一部文字色を赤に
.Range(adrs入力_文字色変更対象範囲).Font.Color = vbRed
'次の入力欄へアクティブセルを動かす
.Range(adrs入力_年分).Select
'訂正をやめるために入力ID_呼出用の数字を削除したとき（手動削除又は訂正入力内容を転記するイベント発生により入力ID_呼出用が削除したとき）
Case Target.Address(0, 0) = adrs入力_入力ID_呼出用 And Target.Value = ""
'訂正入力しないということなので、文字色を黒に戻す
.Range(adrs入力_文字色変更対象範囲).Font.Color = vbBlack
'次の入力欄へアクティブセルを動かす
.Range(adrs入力_年分).Select
End Select
End With
Application.EnableEvents = True
End Sub
'■■■■■セレクションチェンジイベント■■■■■
Private Sub Worksheet_SelectionChange(ByVal Target As Range)
'イベント二重起動防止
Application.EnableEvents = False
'シート設定
Dim ws入力 As Worksheet: Set ws入力 = Me
'目的：BackTabボタン、Tabボタンで移動できるようにアクティブセルを制御
'ここはセル番地を直打ちした方が分かり易いと思う
Select Case Target.Address(0, 0)
'BackTab用
Case "B5"
Range("C4").Select
Case "B6"
Range("C5").Select
Case "B7"
Range("C6").Select
Case "B8"
Range("C7").Select
Case "B9"
Range("C8").Select
Case "B10"
Range("C9").Select
Case "B11"
Range("C10").Select
Case "B12"
Range("C11").Select
Case "B13"
Range("C12").Select
Case "B14"
Range("C13").Select
Case "B15"
Range("C14").Select
'Tab用
Case "D４"
Range("C5").Select
Case "D5"
Range("C6").Select
Case "D6"
Range("C7").Select
Case "D7"
Range("C8").Select
Case "D8"
Range("C9").Select
Case "D9"
Range("C10").Select
Case "D10"
Range("C11").Select
Case "D11"
Range("C12").Select
Case "D12"
Range("C13").Select
Case "D13"
Range("C14").Select
Case "D14"
Range("C15").Select
End Select
'転記
'目的：「転記実行」と書いてあるセルでEnterキーを押した場合、①単純転記し、さらに②入力ID呼出用の値が入っていいる場合には微調整をする。
If Target.Address(0, 0) = adrs入力_転記実行セルの1つ下 Then
'①入力欄からDB範囲へ転記する
With ws入力
'注）ループ内で変数宣言しても宣言処理は1回しか実行されないので問題なし
Dim RNo転記先 As Long: RNo転記先 = .Range(CLetter転記先_年分 & .Rows.Count).End(xlUp).Row + 1
'転記作業
'注）漢数字の〇と記号の〇は違うので全プロシージャで統一しておかないと正しく動作しない
.Range(CLetter転記先_印刷対象 & RNo転記先).Value = "〇"
.Range(CLetter転記先_集計年月 & RNo転記先).Value = .Range(adrs入力_集計年月)
.Range(CLetter転記先_年分 & RNo転記先).Value = .Range(adrs入力_年分)
.Range(CLetter転記先_台帳ER区分 & RNo転記先).Value = .Range(adrs入力_台帳ER区分)
.Range(CLetter転記先_台帳下4桁 & RNo転記先).Value = .Range(adrs入力_台帳下4桁)
.Range(CLetter転記先_バッチ下4桁 & RNo転記先).Value = .Range(adrs入力_バッチ下4桁)
.Range(CLetter転記先_有還無区分 & RNo転記先).Value = .Range(adrs入力_有還無区分)
.Range(CLetter転記先_SKoku区分 & RNo転記先).Value = .Range(adrs入力_SKoku区分)
.Range(CLetter転記先_件数 & RNo転記先).Value = .Range(adrs入力_件数)
.Range(CLetter転記先_誤り有無 & RNo転記先).Value = .Range(adrs入力_誤り有無)
.Range(CLetter転記先_連絡日 & RNo転記先).Value = .Range(adrs入力_連絡日)
.Range(CLetter転記先_回付日 & RNo転記先).Value = .Range(adrs入力_回付日)
End With
'② 転記時に入力ID呼出用が書いてあったら（新しい入力IDとして転記済なので）古い入力IDの行について印刷対象から除外。入力ID呼出用セルは初期化する。
With ws入力
If .Range(adrs入力_入力ID_呼出用).Value <> "" Then
Dim m As String
m = ""
m = "入力ID" & .Range(adrs入力_入力ID_呼出用).Value & "を印刷対象から除外します。"
MsgBox m
'目的：呼出後転記済の「入力ID」行の「印刷対象」列の〇を削除し､呼び出したときに使用した入力欄の「入力ID呼出用」セルのデータを削除して初期化
'データベース部分から取得する行
Dim RNoデータベース_取得行: RNoデータベース_取得行 = RNoデータベース_タイトル行番号 + ws入力.Range(adrs入力_入力ID_呼出用).Value
'印刷対象欄の〇を削除
.Range(CLetter転記先_印刷対象 & RNoデータベース_取得行).Value = ""
'呼び出しに使った入力ID呼出用セルの値を削除
.Range(adrs入力_入力ID_呼出用).Value = ""
'訂正入力終了したので、文字色を黒に戻す（一手前でセルの値削除時にenableEbentして値削除イベントにより文字を黒くするより、ここで単純に文字を黒に戻した）
.Range(adrs入力_文字色変更対象範囲).Font.Color = vbBlack
End If
End With
'入力欄の先頭セルをアクティブにする
Range(adrs入力_年分).Select
End If
'イベント起動可に戻す
Application.EnableEvents = True
End Sub
Option Explicit
'ここは電所シートモジュール（出力帳票１）
'■■■■ワークシートチェンジイベントでオートシェイプの丸囲みを移動する
'最初にこれだけ作ったのでこれを生かして暫定運用
Private Sub Worksheet_Change(ByVal Target As Range)
Const adrsMySK区分 = "R7"
'整理表のSK区分のx座標とｙ座標一覧
Const yoko内 = 270: Const yoko分 = 355: Const yoko訂正 = 473
Const tate内 = 190: Const tate分 = 290: Const tate訂正 = 190
Const yoko後 = 270: Const yoko損 = 355: Const yoko修 = 473
Const tate後 = 250: Const tate損 = 250: Const tate修 = 250
If Not (Intersect(Target, Me.Range(adrsMySK区分)) Is Nothing) Then
' sk区分を番号で入力セルから取得
Dim mySK区分 As Long: mySK区分 = Me.Range(adrsMySK区分).Value
Dim x As Long, y As Long
Select Case mySK区分
Case 1
x = yoko内
y = tate内
Case 2
x = yoko分
y = tate分
Case 3
x = yoko訂正
y = tate訂正
Case 4
x = yoko後
y = tate後
Case 5
x = yoko損
y = tate損
Case 6
x = yoko修
y = tate修
End Select
'〇囲みを移動
'注）オートシェイプの〇囲みを削除してしまったら、図形の名前を書き換える必要がある
Me.Shapes.Range("Oval 1").Left = x
Me.Shapes.Range("Oval 1").Top = y
End If
End Sub
Option Explicit
'ここは電所手差しシートモジュール（出力帳票２）
'■■■■ワークシートチェンジイベントでオートシェイプの丸囲みを移動する
'最初にこれだけ作ったのでこれを生かして暫定運用
Private Sub Worksheet_Change(ByVal Target As Range)
Const adrsMySK区分 = "R7"
'整理表のSK区分のx座標とｙ座標一覧
Const yoko内 = 270: Const yoko分 = 355: Const yoko訂正 = 473
Const tate内 = 190: Const tate分 = 290: Const tate訂正 = 190
Const yoko後 = 270: Const yoko損 = 355: Const yoko修 = 473
Const tate後 = 250: Const tate損 = 250: Const tate修 = 250
If Not (Intersect(Target, Me.Range(adrsMySK区分)) Is Nothing) Then
' sk区分を番号で入力セルから取得
Dim mySK区分 As Long: mySK区分 = Me.Range(adrsMySK区分).Value
Dim x As Long, y As Long
Select Case mySK区分
Case 1
x = yoko内
y = tate内
Case 2
x = yoko分
y = tate分
Case 3
x = yoko訂正
y = tate訂正
Case 4
x = yoko後
y = tate後
Case 5
x = yoko損
y = tate損
Case 6
x = yoko修
y = tate修
End Select
'〇囲みを移動
'注）オートシェイプの〇囲みを削除してしまったら、図形の名前を書き換える必要がある
Me.Shapes.Range("Oval 1").Left = x
Me.Shapes.Range("Oval 1").Top = y
End If
End Sub
４ 参考
『マジックナンバーを減らそうとすると、書き始めは大変かもしれません。
しかし、定数定義さえ終わってしまえば、あとはスムーズにコードが書けます。
さらには改修が発生したときや、あとで発見されたバグを修正するときには、
定数だけいじればよいというメンテナンス性で、すさまじい効果を実感できます。
マジックナンバーを減らすことは「未来への贈り物」です。
贈る相手が自分にせよ他人にせよ、未来の誰かが苦労しないために、
マジックナンバーをがんばって減らしていきましょう。』
