例

実行コード

'※「Microsoft Scripting Runtime」への参照設定が必要
Dim Source As String
Dim Values As New Scripting.Dictionary

'変数を含む文字列
Source = "name='${name}', age=${age}, birthday=${birthday}"

'変数の値
Call Values.Add("name", "山田　太郎")
Call Values.Add("age", 20)
Call Values.Add("birthday", DateValue("2000/4/1"))

'文字列内の変数展開の実行
Debug.Print SubstituteVariables(Source, Values)

出力結果

name='山田 太郎', age=20, birthday=2000/04/01

ソースコード

SubstituteVariables.bas


'※「Microsoft Scripting Runtime」への参照設定が必要
Function SubstituteVariables(Source As String, Values As Scripting.Dictionary) As String

    Static VariableParser As Object

    Dim Matches As Object
    Dim Match As Object
    Dim StringArray() As String
    Dim ArrayIndex As Long
    Dim PrevStringIndex As Long
    Dim VariableName As String

    If Values Is Nothing Then
        SubstituteVariables = Source
        Exit Function
    End If

    If Values.Count = 0 Then
        SubstituteVariables = Source
        Exit Function
    End If

    If VariableParser Is Nothing Then
        Set VariableParser = CreateObject("VBScript.RegExp")
        With VariableParser
            .Global = True
            .IgnoreCase = False
            .MultiLine = False
            .Pattern = "(\$+)\{([^}]+)\}"
        End With
    End If

    Set Matches = VariableParser.Execute(Source)

    If Matches.Count = 0 Then
        SubstituteVariables = Source
        Exit Function
    End If

    ReDim StringArray(1 To Matches.Count * 2 + 1) As String
    ArrayIndex = 1
    PrevStringIndex = 1

    For Each Match In Matches

        If Match.FirstIndex - PrevStringIndex + 1 > 0 Then
            StringArray(ArrayIndex) = Mid(Source, PrevStringIndex, Match.FirstIndex - PrevStringIndex + 1)
            ArrayIndex = ArrayIndex + 1
        End If

        If Match.SubMatches(0) = "$" Then

            VariableName = Match.SubMatches(1)
            Debug.Assert VariableName <> ""

            If Values.Exists(VariableName) Then
                StringArray(ArrayIndex) = Values(VariableName)
                ArrayIndex = ArrayIndex + 1
            Else
                StringArray(ArrayIndex) = Match.Value
                ArrayIndex = ArrayIndex + 1
            End If
        Else
            StringArray(ArrayIndex) = Mid(Match.Value, 2)
            ArrayIndex = ArrayIndex + 1
        End If

        PrevStringIndex = Match.FirstIndex + Match.Length + 1
    Next

    If PrevStringIndex <= Len(Source) Then
        StringArray(ArrayIndex) = Mid(Source, PrevStringIndex, Len(Source) - PrevStringIndex + 1)
    End If

    SubstituteVariables = Join(StringArray, "")

End Function