【Excel VBA】【改善2】座標でなく、フォーマットシートに設定したキーに対応する場所に書き込むクラスの仕様変更とリファクタリング♪

ポイント

フォーマットに同じキーを複数箇所に設定したい。今までは、書き込み対象シートには最後のキーにのみ値が代入され、それ以外はキー変数文字列がそのまま書き込まれていた。
フォーマットに同じキーを複数セルに設定した場合、書き込み対象シートの対応セルの全てにキーの値が代入されるようにしたい。
今までのクラス
- 【Excel VBA】セル番号などの絶対座標指定ではなく、セルに変数として指定した文字列に対応した場所に書き込む変数指定で帳票を楽に作れるようにするクラス！ – oki2a24
- 【Excel VBA】【改善】フォーマットワークシートに指定した変数に対応する場所に書き込むクラスのリファクタリング・機能追加いたしました！ – oki2a24

エクセル準備

ワークシート: Template、Target
Template ワークシート

**start	**today
**start		**name
これは変数ではない
		**end

Target ワークシートは記入なし

VBA コード

Range の 2 次元配列の要素を1つずつ見ていき、要素の値がキーであればキーの値に入れ替えることで実現
CreateValuesIndexesDictionary メソッド (Key が 2 次元配列の値、Item が 2 次元配列のインデックスのディクショナリを返却します。) は不要だった。

以前はテンプレートの変数をキーに、キーに対応するワークシートの座標を値にしたディクショナリを一旦生成していたが、必要なかった。

''' <summary>
''' 本クラスのプロパティのキーと値に設定した内容を書き込み対象ワークシートに書き込むクラス
''' 書き込むキーの座標は、フォーマットのワークシートに予め設定します。
''' フォーマットに同じキーを複数セルに設定した場合、
''' 書き込み対象シートの対応セルの全てにキーの値が代入されます。
''' キーがフォーマットのみに設定され、本クラスのプロパティに設定されていない場合、
''' 書き込み対象シートには変数名がそのまま書き込まれます。
''' キーがフォーマットに設定されておらず、本クラスのプロパティにのみ設定されている場合、
''' そのキーは無視されて書き込まれます。
''' </summary>

Option Explicit

Private mstrClassName As String

Private mobjTargetRange As Range
' テンプレート Range.Value をコピーした 2 次元配列
Private mvntValues As Variant
''' <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 strTemplateRange As String, _
  ByVal strTargetWorksheet As String, _
  ByVal strTargetRange As String)

  Debug.Print (mstrClassName & " : Init")

  ' 変数をセット
  Set mobjTargetRange = Worksheets(strTargetWorksheet).Range(strTargetRange)
  mvntValues = Worksheets(strTemplateWorksheet).Range(strTemplateRange)
End Sub

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

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

  ' 書き込みデータを生成
  Dim i As Long
  Dim j As Long
  For i = LBound(mvntValues, 1) To UBound(mvntValues, 1)
    For j = LBound(mvntValues, 2) To UBound(mvntValues,2)
      ' CellValuesキーの値があれば、その値へ入れ替え
      If CellValues.Exists(mvntValues(i, j)) Then
        vntCopied(i, j) = CellValues(mvntValues(i, j))
      End If
    Next j
  Next i

  ' 書き込み対象ワークシートに書き込み
  mobjTargetRange = vntCopied
End Sub

''' <summary>
''' 書き込み対象ワークシートに書き込み、その後、書き込み先範囲を移動します。
''' </summary>
''' <param name="lngRowOffset">オフセットする範囲の行数</param>
''' <param name="lngColumnOffset">オフセットする範囲の列数</param>
Public Sub WriteToVariableAndOffset( _
  ByVal lngRowOffset As Long, _
  ByVal lngColumnOffset As Long)

  Debug.Print (mstrClassName & " : WriteToVariableAndOffset")

  Call WriteToVariable
  Set mobjTargetRange = mobjTargetRange.Offset(lngRowOffset, lngColumnOffset)
End Sub

''' <summary>
''' 書き込み対象ワークシートに書き込み、その後、書き込み先範囲を下に移動します。
''' </summary>
''' <param name="lngRow">下に移動する行数</param>
Public Sub WriteToVariableAndDown(ByVal lngRow As Long)
  Debug.Print (mstrClassName & " : WriteToVariableAndDown")

  Call WriteToVariableAndOffset(lngRow, 0)
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("**start") = "スタート後勝ち！"
  udtVw.CellValues("**name") = ""
  udtVw.CellValues("**option") = "オプション"
  udtVw.CellValues("**end") = "エンド♪"
  ' 書き込み
  udtVw.WriteToVariableAndDown(4)

  ' 2 回目
  udtVw.CellValues("**start") = "スタート2！"
  udtVw.CellValues("**name") = "名前入れる"
  udtVw.CellValues("**today") = Format(Now, "yyyy/mm/dd")
  udtVw.CellValues("**option") = "オプション"
  udtVw.CellValues("**end") = "エンド2♪"
  udtVw.WriteToVariable
End Sub

おわりに

冒頭でも紹介いたしましたけれども、これらの更に改善版となります。

実際に使用してみますと、今回のようにポロポロと使いづらい点がわかってきますの♪

改善できましたら、嬉しいですわ！

以上です。

ポイント

エクセル準備

VBA コード

おわりに

関連

コメントを残すコメントをキャンセル