【Excel VBA】セル番号などの絶対座標指定ではなく、セルに変数として指定した文字列に対応した場所に書き込む変数指定で帳票を楽に作れるようにするクラス！

追記: 改善版です！

• 【Excel VBA】【改善】フォーマットワークシートに指定した変数に対応する場所に書き込むクラスのリファクタリング・機能追加いたしました！ – oki2a24
• 【Excel VBA】【改善2】座標でなく、フォーマットシートに設定したキーに対応する場所に書き込むクラスの仕様変更とリファクタリング♪ – oki2a24

---

なぜ実現したかったのか？

• エクセル方眼紙での帳票は、ちょっとデザイン変更すると簡単に絶対座標がずれてしまい、VBA の座標修正が辛い。
• ExcelCreator のように、ワークシートに変数として入力したセルの内容を書き換えて出力したら楽になると考えた。
  • 製品情報 – ExcelCreator 2012 | アドバンスソフトウェア株式会社
  • “A1 参照形式”、”座標形式”、”セルの名前”、”変数名”の 4 つの方法で値を差し込むセルの指定が可能。”変数名”での差し込みを目指したのが本投稿
• セルの座標を気にする必要がなくなることがメリット
  • テンプレートのワークシートのデータを反映したいセルに変数を書き込めば良い。座標は気にしなくて良い。
  • VBA ではセルの変数に対してデータを差し込めば良い。座標を指定しなくて良い。
  • セルの名前を使う方法もある。ただし、セルの名前は扱いやすい形でワークシートに表示することができず、辛い。

処理の流れ

ワークシートテンプレートのセルに記入する変数と、その座標と、VBA に書くワークシートテンプレートの変数名と、代入する値をどうやって紐付けるかが重要です。

次に挙げるポイントの考えでつなげるようにいたしました。

ポイント

• テンプレートの変数をキーに、そこに対応するワークシートの座標を値にして VBA で取り込んでディクショナリ 1 を作る。
• テンプレートの変数をキーに、そこに当てはめる値を値にしてのディクショナリ 2 を作る。
• ディクショナリ 2 をループして、テンプレートの変数を仲立ちにして、変数に当てはめる値と、ワークシートの場所をひも付け。
• ワークシートへの書き込みは、2次元配列を Range に代入して 1 回で行う。速さを保つ。

もう少し具体的にしますと、次のようになります。

1. 初期処理

1. VariableWriter クラスをインスタンス化
2. VariableWriter.Init
   • テンプレートとなるワークシート、その Range、書き込み先のワークシート、その Range、を設定
   • テンプレートの Range.Value を 2次元配列として mvntValues にまるっとコピー
   • mvntValues からディクショナリ mobjTplValuesPositions (Key: セルの値、Item: 配列位置) 作成。キー重複時は後勝ち (上書き)。

2. ワークシートの変数名と、差し込む値を設定

1. クラス外から書き込む値を設定する。次のようなイメージ
   VariableWriter.CellsValues("**NowDate") = Format(Now, "yyyymmddhhnnss")

3. エクセルワークシートへ書き込み

1. VariableWriter.WriteToVariable
   1. VariableWriter.CellValues をループする。ちなみに、ループ要素 (v とする) は VariableWriter.CellValues のキー
   2. mobjTplValuesPositions(v) で Item を取り出し、2次元配列の場所を取得
   3. VariableWriter.CellValues(v) で Item を取り出し、書き込む内容を取得
   4. mvntValues の「2次元配列の場所」を指定して「書き込む内容」を設定
   5. 書き込み先シートの Range に mvntValues を代入して完了

ここからは、実際の VBA コードとなりますわ。そのまえにテンプレートシートと書き込まれるシートを用意して、実際に試せるように準備もいたします。

エクセル準備

Template シート

A1 セルから C4 セルの範囲をテンプレートとします。

そして、A1 セルに **start という名前の変数を、C4 セルに **end という名前の変数を設定しました。次のようなイメージとなります。

**start
		**end

Target シート

プログロムを実行することで書き込まれるシートですので、特に何も記入しておりません。

VBA コード

Option Explicit

Private mstrClassName As String

Private mobjTemplateWorksheet As Worksheet
Private mobjTargetWorksheet As Worksheet
Private mstrTargetRange As String

' テンプレート Range.Value をコピーした 2 次元配列
Private mvntValues As Variant
Private mobjTplValuesPositions As Object
''' <summary>
''' ワークシートの変数 (Key) と、差し込む値 (Item)
''' </summary>
Public CellValues As Object

''' <summary>
''' コンストラクタ
''' </summary>
Private Sub Class_Initialize()
  mstrClassName = TypeName(Me)
  Debug.Print (mstrClassName & " : Constructor is called.")

  Set CellValues = CreateObject("Scripting.Dictionary")
End Sub

''' <summary>
''' デストラクタ
''' </summary>
Private Sub Class_Terminate()
  Debug.Print (mstrClassName & " : Destructor is called.")
End Sub

''' <summary>
''' 初期化処理を実行します。
''' </summary>
''' <param name="strTemplateWorksheet">テンプレートワークシート</param>
''' <param name="strTemplateRabge">テンプレート範囲</param>
''' <param name="strTargetWorksheet">書き込み先ワークシート</param>
''' <param name="strTargeteRabge">書き込み先範囲</param>
Public Sub Init( _
  ByVal strTemplateWorksheet As String, _
  ByVal strTemplateRabge As String, _
  ByVal strTargetWorksheet As String, _
  ByVal strTargeteRabge As String)

  Debug.Print (mstrClassName & " : Init")

  ' 変数をセット
  Set mobjTemplateWorksheet = Worksheets(strTemplateWorksheet)
  Set mobjTargetWorksheet = Worksheets(strTargetWorksheet)
  mstrTargeteRabge = strTargeteRabge

  mvntValues = mobjTemplateWorksheet.Range(strTemplateRabge)
  Set mobjTplValuesPositions = CreateValuesIndexesDictionary(mvntValues)
End Function

''' <summary>
''' Key が 2 次元配列の値、Item が 2 次元配列のインデックスのディクショナリを返却します。
''' Key が重複する場合は上書きします。
''' Item に格納する 2 次元配列のインデックスは Array(1, 1) 形式の配列です。
''' </summary>
''' <param name="vntTwoArray">2 次元配列</param>
Private Function CreateValuesIndexesDictionary( _
  ByVal vntTwoArray As Variant) As Object

  Dim objResults As Object
  Set objResults = CreateObject("Scripting.Dictionary")

  Dim i As Long
  Dim j As Long

  For i = LBound(vntTwoArray, 1) To UBound(vntTwoArray, 1)
    For j = LBound(vntTwoArray, 2) To UBound(vntTwoArray,2)
      objResults.(vntTwoArray(i, j)) = Array(i, j)
    Next j
  Next i

  Set CreateValuesIndexesDictionary = objResults
End Function

''' <summary>
''' 書き込み対象ワークシートに書き込みます。
''' </summary>
Public Sub WriteToVariable()
  Debug.Print (mstrClassName & " : WriteToVariable")

  ' Range.Value コピー配列の複製を用意し、元の配列はそのままの形で残す。
  Dim vntCopied As Variant
  vntCopied = mvntValues

  Dim vntRowCol As Variant
  Dim lngRow As Long
  Dim lngCol As Long
  Dim vntValue As Variant
  Dim v As Variant
  For Each v In CellValues
    ' Range.Value コピー配列の複製への書き込み場所を取得
    vntRowCol = mobjTplValuesPositions(v)
    lngRow = vntRowCol(0)
    lngCol = vntRowCol(1)

    ' Range.Value コピー配列の複製に代入する更新値を取得
    vntValue = CellValues(v)

    ' Range.Value コピー配列の複製を更新
    vntCopied(lngRow, lngCol) = vntValue
  Next v

  ' 書き込み対象ワークシートに書き込み
  mobjTargetWorksheet.Range(mstrTargetRange) = vntCopied
End Sub

続いて、クラスの動きを確認するためのコードです。

Option Explicit

Public Sub TestVariableWriter()
  ' 初期化
  Dim udtVw As VariableWriter
  Set udtVw = New VariableWriter
  Call udtVw.Init("Template", "A1:C4", "Target", "A1:C4")

  ' 書き込み先変数と、値を設定
  udtVw.CellValues("**start") = "スタート！"
  udtVw.CellValues("**end") = "エンド♪"

  ' 書き込み
  udtVw.WriteToVariable
End Sub

結果

Template シート

テンプレート、コピー元ですので特に何も起こりません。

Target シート

VBA で **start と **end に設定した値が次のように反映されておりました♪

スタート！
		エンド♪

成功です。やったぜ！

おわりに

もう少し改善の余地があるような気がいたしますの。そもそもの処理のおおまかな流れもそうですし、コードの細かい部分もそうですし。。。

今はこれで精一杯ですわ！

ぱっと思いついたアイデアですけれども今後の展望として、次のように機能追加すると便利そうですの。

• VariableWriter.WriteToVariableAndOffset といった関数を作る。これにより、書き込み対象ワークシートに書き込んだ後に、書き込み範囲を移動させる。結果、一度に複数の帳票を作れるようになる。
  • mvntValues のコピーを作ってそれを使って書き込み対象ワークシートに反映するように変更する。現状では、書き込めるのは一度切りのため。 ← 公開前に対応済み。
  • 完全コンストラクタパターンから外れて複雑さが増してしまうが、仕方がない。。。

参考になったページです♪ありがとう存じます！

• 「rangeを配列に代入」で検索
  • Office TANAKA – Excel VBA高速化テクニック[セルを配列に入れる]
• ディクショナリへの追加、取得
  • 【Excel VBA】重複しないリスト作成や、要素が 1 種類のみかどうかを判定するコード！ | oki2a24
  • Excel(エクセル)VBA入門：Dictionaryを利用する

以上です。