k01ken’s b10g

He110 W0r1d!

VBA(Excel)で列をずらした際に修正するのが面倒なことに対する対策

開発環境は、Windows 10 Pro(64bit)。動作検証はExcel 2019。

Excelでテーブル形式のデータをVBAで処理する場合、完成したファイルの列の位置を変更するような修正をした場合、関係する部分をすべて修正しなければいけないので、非常に面倒くさく、保守性が悪いです。そこで、どうすればいいか考えたところ、列の見出しと列のアルファベットをディクショナリ型の対応関係にして、処理すれば、何とか、いちいち修正することなくできるのではないか?と思い、以下のコードを書いてみました。

'[関数名]
'列の自動設定
'[関数の機能]
'列を追加するとズレてしまう対策として、列の見出しとアルファベットを対応させることにした
'ただし、前提条件として、見出しが重複しないこと、かつ、空白でないこと
'[使用するタイミング]
'列を追加、削除、移動するたびに起動させる
'[引数]
'rng Range - "A1"などの、列の開始(一番左)のセルを指定
'dict Object(Scripting.Dictionary) - データを入れるための連想配列のオブジェクト
'[戻り値]
'なし
'[動作検証]
'検証済み

Function 列の自動設定(ByRef rng As Range, ByRef dict As Object)
  'リセットする
  Set dict = CreateObject("Scripting.Dictionary")
  Dim 行番号 As Long
  Dim 最初の列番号 As Long
  Dim 最後の列番号 As Long
  
  行番号 = rng.Row
  最初の列番号 = rng.column
  rng.End(xlToRight).Select
  最後の列番号 = ActiveCell.column
  
  '対応するデータが完成
  For i = 最初の列番号 To 最後の列番号
    dict.Add cells(行番号, i).Value, Split(cells(行番号, i).Address(True, False), "$")(0)
  Next i
End Function

'使い方
Sub Main()
  Dim dict As Object
  Set dict = CreateObject("Scripting.Dictionary")
  '例えば、見出しが一行目にあって一番左のアドレスがA1だった場合
  Call 列の自動設定(ActiveSheet.Range("A1"), dict)

  For Each itm In dict
    Debug.Print(itm & ":" & dict(itm))
  Next itm

  '後は、列のアルファベットを指定する部分で、dict("列の見出し")の変数を渡すだけ
  'そして、列を変更するたびに、『列の自動設定』関数を起動して修正するだけ
  'dict.Item("年齢")
  'のように指定する。
End Sub

使ってみると、修正が、かなり、楽になり、面倒くさいなぁという気持ちも軽減しました。