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
雑談
修正を躊躇う理由が、シートのレイアウト変更が苦行だから、というのはちょっと違う。
そのシートを使って何かしらの業務が便利になることが目的なので、使う人にとって不便なら気持ちよく修正対応したい。
使う前に判断できる人は稀有だ、普通は実際に使い始めないと便利か不便か分からないものだ、と思っておく。
今のコーディング量が少し増え、処理能力が少し余分にかかり、何かしら制限があったとしても、レイアウト変更しやすい方がいい。と思う。