VBAメモ：シートのレイアウト変更に伴うVBAコード修正を減らしたい。

Excelで何かしら業務ツールが完成。
で、後から「この列とこの列の順番入れ替えて」とか言われませんか。

シートの行や列は、使い始めてから変更したくなる。
だから先に確認したのに、とか、通用しない。
シートのレイアウトは随時変わる、もう、それを前提にすべきじゃないですかね…。

以下、あくまで個人的メモなので、ベストプラクティスかどうかは不明です。

列を数字で書かない

例えば商品リストみたいな、見出しがあって、下にずらーっとデータがあるようなタイプの表。

商品コードを参照したい、商品コードはA列（1列目）だなーと、べた書きするとこうなる。

ダメな例

With シート指定して
  .Cells(tmpRow, 1)  ' 商品コード

その後、例えば先頭に1列追加されて、商品コードがB列（2列目）になったとする。

1を2に変更するだけ、ではあるのだけど、1と言う文字はソース中に無数にある。
検索結果の中から、列数として使われている「1」を特定するのが面倒。
コメントを頼りにするのも限界があるし、ヘタすると全部目検するハメになる。

そこで、こうした。

itemCodeCol = getCol("商品コード")
.Cells(tmpRow, itemCodeCol)

見出し名を渡すと列数を返す、getColという関数を作った。
商品コードが何列目に移動しようが、それが「商品コード」である限り、VBAのコード修正は不要だ。

見出しが変わったら修正が必要になるが、機械的な置換で対応できる。
たとえば「商品コード」⇒「商品CD」に変更されたら、「getCol("商品コード")」⇒「getCol("商品CD")」と置換する。
関数名も含めて置換すれば間違いない。

見出しで列を特定する関数

で、そのgetColというのは以下のような内容。

Const titleRow As Long = 2 ' 見出しは2行目。シートの列変更時は、ここを変更。

' 見出しテキストを受け取り、列数を返す
Public Function getCol(findTitle As String) As Long

    Dim maxCol As Long, tmpCol As Long
    Dim title As String, result As Long

    ' 空白削除
    findTitle = trimAll(findTitle) 

    ' 結果として返す列数、デフォルト0
    result = 0

    ' 対象は表示中シート、必要なら引数で受け取るようにしても良いかも
    With ActiveSheet
        ' 最大列数
        maxCol = .Cells(titleRow, Columns.count).End(xlToLeft).Column
        ' 1列目～最大列までループ
        For tmpCol = 1 To maxCol
            ' 空白削除して比較
            title = trimAll(.Cells(targetRow, tmpCol))
            If (title = findTitle) Then
                ' 見つけたところで終了
                result = tmpCol
                Exit For
            End If
        Next
    End With

    ' 見つからなかった時にアラートが必要ならば
    ' If result = 0 Then
    '     MsgBox ("見出し「" & findTitle & "」が見つかりませんでした")
    ' End If

    ' 列数を返す
    getTitleCol = result

End Function

' 空白削除
Public Function trimAll(text As String) As String
    text = Replace(text, "　", "")   ' 全角スペース
    text = Replace(text, " ", "")    ' 半角スペース
    text = Replace(text, vbCr, "")
    text = Replace(text, vbLf, "")
    text = Replace(text, vbTab, "")
    trimAll = text
End Function

上記はシートはActivesheet、見出し行は定数指定してる例。
プロジェクト内容によっては、シートや見出し行も引数で受けとるようにすることもある。

この関数は、見出しテキストがユニークでないと、思ったように動作しない。
見出し文字が見つかった時点でループを抜けるので、同じ見出しが複数あっても、先（左）の列数しか取れない。
列移動時にソース変更しなくて良いことと引き換えだし、まあいいかなと思っている。

空白削除関数は、見栄え整え勢対策。
彼らは、セル内改行とかテキストを折り返す＋空白とかを使いがちなので。

名前付き範囲を使う

ソースコードにアドレスべた書きしたくないあまり、単体セルの特定に名前付き範囲を使うことがある。
カット＆ペーストの移動なら、名前付き範囲も一緒に移動してくれるので、レイアウト変更しやすい。

しかし運用が始まると、あらかじめ「この欄は勝手に消したり動かしたりしないでね」と注意していても、触る人が居る（そして何も触ってないと言う）。
未来の自分がうっかりやらかす可能性も、もちろんある。

名前付き範囲が無いときのエラーをマイルドにするため、先に存在確認をする。

使う時

If existsRangeName("納品日") Then
    date = Range("納品日")  ' 本当に日付なのか、とか、あとでチェックしたほうがいい
Else
    MsgBox("納品日を特定できませんでした。シートが変更されたようなので、管理者にご連絡ください。")
End If

名前付き範囲の存在を確認する関数

確認用の関数はこんな感じ。
試しに選択してみる、という、割と原始的な方法…。

' 指定された名前付き範囲が存在するか確認
Function existsRangeName(rangeName As String) As Boolean

    Dim tmp

    existsRangeName = False

    ' 試しに選択する前に、現状保存しとく
    Set tmp = Selection

    ' 名前付き範囲選択してみる
    On Error GoTo EXIT
    Range(rangeName).Select

    ' EXITに行かなかったということは、選択できた。存在する。
    existsRangeName = True
EXIT:
    ' 結果にかかわらず、選択を元に戻して終了
    tmp.Select
End Function

雑談

修正を躊躇う理由が、シートのレイアウト変更が苦行だから、というのはちょっと違う。
そのシートを使って何かしらの業務が便利になることが目的なので、使う人にとって不便なら気持ちよく修正対応したい。
使う前に判断できる人は稀有だ、普通は実際に使い始めないと便利か不便か分からないものだ、と思っておく。

今のコーディング量が少し増え、処理能力が少し余分にかかり、何かしら制限があったとしても、レイアウト変更しやすい方がいい。と思う。