VBA 固定長のコードを扱うオブジェクトをクラスモジュールで作ってみた

業務では固定長のコードを扱うプログラムを作ることがある。

例えば以下のようなコードがあったとする。
20180728MPG

これは私が考えた適当なコードだが、2018年7月28日生まれの男性プログラマーを表すことにする。

つまり先頭8桁が生年月日、次の1桁が性別、最後の2桁が職業を表す。

たとえばこのコードの性別だけ取り出したいと思ったら、9文字目から1文字切り出すという処理が必要になるが、これが結構面倒くさいのでクラスモジュールを使って楽に取り出せる仕組みを考えてみた。

まずクラスモジュールを挿入し、オブジェクト名を「FixedLengthCode」に変更する。
クラスのコードはこちら。

PublicValueAsStringPrivate codeDefinisions()As codeDefinision
PrivateType codeDefinision
    description AsString
    startLocation AsInteger
    length AsIntegerEndTypeSub AddDefinition(description AsString, length)ReDimPreserve codeDefinisions(UBound(codeDefinisions)+1)
    codeDefinisions(UBound(codeDefinisions)).description = description
    codeDefinisions(UBound(codeDefinisions)).length = length
    codeDefinisions(UBound(codeDefinisions)).startLocation _= codeDefinisions(UBound(codeDefinisions)-1).startLocation _+ codeDefinisions(UBound(codeDefinisions)-1).length
EndSubPrivateFunction getDefinision(description AsString)As codeDefinision
    Dim i AsIntegerFor i =LBound(codeDefinisions)ToUBound(codeDefinisions)If codeDefinisions(i).description = description Then
            getDefinision = codeDefinisions(i)ExitFunctionEndIfNextEndFunctionSub ReplacePart(description AsString, code AsString)Dim d As codeDefinision
    d = getDefinision(description)Mid(Value, d.startLocation, d.length)= code
EndSubFunction GetPart(description AsString)AsStringDim d As codeDefinision
    d = getDefinision(description)
    GetPart =Mid(Value, d.startLocation, d.length)EndFunctionPrivateSub Class_Initialize()ReDim codeDefinisions(0)
    codeDefinisions(0).description ="dummy"
    codeDefinisions(0).length =0
    codeDefinisions(0).startLocation =1EndSub

このFixedLengthCodeオブジェクトを使うと、コードのパーツごとに名前をつけて名前でアクセスできるようになる。
そしてこのオブジェクトを使って固定長コードを扱うサンプルはこちら。

Sub Main()'オブジェクト生成Dim code As FixedLengthCode
    Set code =New FixedLengthCode
    
   '定義の登録。定義名と桁数を順に登録する。
    code.AddDefinition "生年月日",8
    code.AddDefinition "性別",1
    code.AddDefinition "職業",2'値のセット
    code.Value="20180728MPG"'パーツの取り出しサンプル
    Debug.Print code.GetPart("職業")
    Debug.Print code.GetPart("生年月日")
    Debug.Print code.GetPart("性別")'パーツの置換サンプル
    code.ReplacePart "性別","F"
    Debug.Print code.Value
    
    code.ReplacePart "生年月日","20170509"
    Debug.Print code.Value
    
    code.ReplacePart "職業","SE"
    Debug.Print code.ValueEndSub

以上