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

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

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

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

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

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

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

Public Value As String
Private codeDefinisions() As codeDefinision
Private Type codeDefinision
    description As String
    startLocation As Integer
    length As Integer
End Type

Sub AddDefinition(description As String, length)
    ReDim Preserve 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
End Sub

Private Function getDefinision(description As String) As codeDefinision
    Dim i As Integer
    For i = LBound(codeDefinisions) To UBound(codeDefinisions)
        If codeDefinisions(i).description = description Then
            getDefinision = codeDefinisions(i)
            Exit Function
        End If
    Next
End Function

Sub ReplacePart(description As String, code As String)
    Dim d As codeDefinision
    d = getDefinision(description)
    Mid(Value, d.startLocation, d.length) = code
End Sub

Function GetPart(description As String) As String
    Dim d As codeDefinision
    d = getDefinision(description)
    GetPart = Mid(Value, d.startLocation, d.length)
End Function

Private Sub Class_Initialize()
    ReDim codeDefinisions(0)
    codeDefinisions(0).description = "dummy"
    codeDefinisions(0).length = 0
    codeDefinisions(0).startLocation = 1
End Sub

この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.Value

End Sub

以上