【ExcelVBA】マッピング(対応表)を使ってユーザー自身によるコードレス修正を意図した転記マクロ その1

1  テーマ 

転記ネタ。転記元、転記先の列構成が変わるとコードを触る必要がある。ユーザーが自分で対応できるようにするため、VBAのコードを変えないで対応できるように対応表を設定シートに作成しておく。

2 前提

 転記先もデータベース状にデータを何件も入れていくパターン。

 今回は入力シートと出力シートが同じシートの場合。

 シート構成は、入力シート(=出力シート)、設定シート

 設定シートの中身は、A列に項目名、B列に入力シートの列構成などの情報、C列に出力シートの列構成などの情報を書く。1行目が見出し行。4行目までは以下。5行目以降には列記号(例:A列の「A」とかG列の「G」などの列記号)を書いてある。

  A列         B列  C列    D列

項目名 入力 出力 摘要
開始行の番号 22 55 出力開始行は初期化で削除する行として使っている。間違えると全部消える
終了行の番号 42 自動 自動とは、計算シートの2列目の最終行の下に書き足していくという意味
日数の列記号 BM 使用せず 転記要否の判定用に使う列

 

3 コード

 

 Option Explicit

Sub 転記()
    'マジックナンバー。設定シートの構成を変えたら要変更
    Const RNo_ws設定_マップ開始行 As Long = 5       '転記に使う対応関係を示すのを開始する行
    Const adrs_ws設定_日数の列記号 = "B4"           '転記をスキップする判定に使う列記号(例:日数セルの列記号「BM」)を設定シートから取得
    Const CLet_ws設定_入力列記号 = "B"
    Const CLet_ws設定_出力列記号 = "C"
    Const CNo_ws設定_最終行判定使用列 = 2
    Const CNo_ws出力_最終行判定使用列 = 2
    
    'マジックナンバー。シート名を変えたら要変更
    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 RNo_ws入力_データ開始行 As Long: RNo_ws入力_データ開始行 = ws設定.Range("B2")
    Dim RNo_ws入力_データ終了行 As Long: RNo_ws入力_データ終了行 = ws設定.Range("B3")
    Dim RNo_ws設定_マップ最終行 As Long: RNo_ws設定_マップ最終行 _
                    = ws設定.Cells(ws設定.Rows.Count, CNo_ws設定_最終行判定使用列).End(xlUp).Row
    Dim R_データ行 As Long, R_マップ行 As Long
    Dim RNo_ws出力_転記先行 As Long: RNo_ws出力_転記先行 _
                    = ws出力.Cells(ws出力.Rows.Count, CNo_ws出力_最終行判定使用列).End(xlUp).Row + 1
    For R_データ行 = RNo_ws入力_データ開始行 To RNo_ws入力_データ終了行
        '日数セルの値チェックして転記スキップするか判定.日数セルにはエラーも入る可能性あり
        Dim CLet_ws入力_日数の列記号 As String: CLet_ws入力_日数の列記号 = ws設定.Range(adrs_ws設定_日数の列記号)
        Dim my表示日数 As Variant: my表示日数 = ws入力.Range(CLet_ws入力_日数の列記号 & R_データ行)
        Select Case True
            Case IsError(my表示日数)
                GoTo skipRow
            Case IsEmpty(my表示日数), my表示日数 = ""
                GoTo skipRow
            Case IsNumeric(my表示日数)
                If my表示日数 = 0 Then GoTo skipRow
        End Select
        '転記 マッピング処理によるので転記自体のコードは1行で済む
        For R_マップ行 = RNo_ws設定_マップ開始行 To RNo_ws設定_マップ最終行
            Dim CLet_ws入力_列記号 As String: CLet_ws入力_列記号 = ws設定.Range(CLet_ws設定_入力列記号 & R_マップ行)
            Dim CLet_ws出力_列記号 As String: CLet_ws出力_列記号 = ws設定.Range(CLet_ws設定_出力列記号 & R_マップ行)
            ws出力.Range(CLet_ws出力_列記号 & RNo_ws出力_転記先行) = ws入力.Range(CLet_ws入力_列記号 & R_データ行)
            
        Next R_マップ行
        
        RNo_ws出力_転記先行 = RNo_ws出力_転記先行 + 1
skipRow:
    Next R_データ行
    
    MsgBox "転記完了"
End Sub

Sub 初期化()
    Const adrs_ws設定_削除開始行 As String = "C2"

    Dim ws設定 As Worksheet: Set ws設定 = ThisWorkbook.Worksheets("設定")
    Dim ws出力 As Worksheet: Set ws出力 = ThisWorkbook.Worksheets("計算")
    Dim RNo_ws出力_初期化開始行 As Long: RNo_ws出力_初期化開始行 = ws設定.Range(adrs_ws設定_削除開始行)
    Dim RNo_ws出力_初期化最終行 As Long: RNo_ws出力_初期化最終行 = ws出力.Range("A" & ws出力.Rows.Count).Row
     
    ws出力.Rows(RNo_ws出力_初期化開始行 & ":" & RNo_ws出力_初期化最終行).ClearContents
    
    MsgBox "初期化完了"
End Sub
   

 

4 参考

 

 

5 その他

変数名はインテリセンスが効くように冒頭に英語を残しつつ日本語変数の読みやすさを採用するため

CLet_設定シートの出力列記号 

などと書こうと思う。1つ目の_はあった方がインテリセンスの時わかりやすいと思うので残す。

CLet_設定シート_出力列記号

CLet_WS設定_出力列記号

などシート名の表記方法、シートとセル範囲の間に_を入れた方が良いか「の」とするかは考え中。