Option Explicit
' ----------------------------------------------------------------------------------------------------------------------------------
'  定数定義
' ----------------------------------------------------------------------------------------------------------------------------------
' シート名
Private Const TEMPLATE_OUTPUT_SHEET = "置換済みテンプレート"

' 改行コード
Private Const NEW_LINE As String = vbLf

' インデント1つ(1レベル)あたりの半角スペースの数
Private Const INDENT_SIZE As Long = 4

' プレースホルダー(単一)の囲い文字
Private Const PREFIX_SINGLE_PLACEHOLDER As String = "%"
Private Const SUFFIX_SINGLE_PLACEHOLDER As String = "%"

' プレースホルダー(リスト)の囲い文字
Private Const PREFIX_LIST_PLACEHOLDER As String = "#"
Private Const SUFFIX_LIST_PLACEHOLDER As String = "#"

' プレースホルダー置換後の囲い文字
Private Const REPLACED_OPEN_MARKER As String = "<<<"
Private Const REPLACED_CLOSE_MARKER As String = ">>>"

' ----------------------------------------------------------------------------------------------------------------------------------
'  Enum定義
' ----------------------------------------------------------------------------------------------------------------------------------
Public Enum eIndentLevel
    Level0 = 0
    Level1
    Level2
    Level3
    Level4
    Level5
End Enum

' ----------------------------------------------------------------------------------------------------------------------------------
'  メソッド：Public
' ----------------------------------------------------------------------------------------------------------------------------------
Public Sub Main()
    Dim persons As Collection
    Set persons = PersonListLoader.LoadExcelDataToList
    
    Dim template As String
    template = BuildTemplate_Root(persons)

    Dim ws As Worksheet
    Set ws = ThisWorkbook.Worksheets(TEMPLATE_OUTPUT_SHEET)
    ws.Cells(1, 1) = template
    ws.Cells.Font.Color = RGB(0, 0, 0)
    
    Call ChangeReplacementColor
End Sub

' ----------------------------------------------------------------------------------------------------------------------------------
'  メソッド：Private
' ----------------------------------------------------------------------------------------------------------------------------------
' テンプレートを置換する
' template: 置換パラメータを含むテンプレート
' params: 置換前後のパラメータ文字列のペア
' indentLevel: 親テンプレートを基準とした相対的なインデントレベル
Private Function BuildTemplate(template As String, params As Dictionary) As String
    Dim replacedTemplate As String
    replacedTemplate = template
        
    Dim regex As regexp
    Set regex = New regexp
    
    Dim pattern As Variant
    For Each pattern In params
        Dim replacement As String
        replacement = params(pattern)
        
        ' リスト要素を置換する
        ' インデントを合わせるため、行ごと置換を行う
        regex.Multiline = True
        regex.pattern = "^[\s　]*" _
                                    & PREFIX_LIST_PLACEHOLDER _
                                    & pattern & SUFFIX_LIST_PLACEHOLDER _
                                    & "[\s　]*"
        replacedTemplate = regex.Replace(replacedTemplate, replacement)
        
        ' 単項目要素を置換する
        regex.pattern = PREFIX_SINGLE_PLACEHOLDER _
                                    & pattern _
                                    & SUFFIX_SINGLE_PLACEHOLDER
        replacedTemplate = regex.Replace(replacedTemplate, REPLACED_OPEN_MARKER & replacement & REPLACED_CLOSE_MARKER)
    Next
    
    BuildTemplate = replacedTemplate
End Function

' テンプレートに対してインデントをする
' インデントのレベルは親テンプレートに対して相対量である
Private Function ApplyIndent(template As String, indentLevel As eIndentLevel)
    ' note: regexpを利用すると末尾の改行が取れてしまうため
    ' 代替として各行に対してインデントを設定している
    Dim splitedList() As String
    splitedList = Split(template, NEW_LINE)
    Dim str As Variant
    Dim joinedString As String
    For Each str In splitedList
        joinedString = joinedString & String(indentLevel * INDENT_SIZE, " ") & str & NEW_LINE
    Next
    ApplyIndent = joinedString
End Function

' 変更箇所の色を変更する
Private Sub ChangeReplacementColor()
    Dim ws As Worksheet
    Set ws = ThisWorkbook.Worksheets(TEMPLATE_OUTPUT_SHEET)
    
    Dim targetRange As Range
    Set targetRange = ws.Cells(1, 1)
    
    Dim task As String
    task = targetRange.value
    
    ' 置換箇所の一覧を取得する
    Dim regex As regexp
    Set regex = New regexp
    regex.Global = True
    regex.Multiline = True
    regex.pattern = REPLACED_OPEN_MARKER & ".+?" & REPLACED_CLOSE_MARKER
    Dim matches As MatchCollection
    Set matches = regex.Execute(task)
    
    ' note: Characters.Deleteのメソッドがなぜか動作しないため、
    ' カラー変更 → Delete ではなく、Delete → カラー変更の順序で処理をする
    task = Replace(task, REPLACED_OPEN_MARKER, "")
    task = Replace(task, REPLACED_CLOSE_MARKER, "")
    targetRange.value = task
    
    Dim markerLength As Long
    markerLength = Len(REPLACED_OPEN_MARKER) + Len(REPLACED_CLOSE_MARKER)
    Dim i As Long
    For i = 0 To matches.count - 1
        Dim match As match
        Set match = matches.Item(i)
        Dim beginIndex As Long
        Dim charLength As Long
        beginIndex = (match.FirstIndex + 1) - (i * markerLength)
        charLength = match.Length - markerLength
        targetRange.Characters(beginIndex, charLength).Font.Color = RGB(255, 124, 128)
        targetRange.Characters(beginIndex, charLength).Font.Bold = True
    Next
End Sub

Private Function BuildTemplate_Root(persons As Collection) As String
    Dim person As PersonData
    Dim bloodAPersons As Collection
    Set bloodAPersons = New Collection
    For Each person In persons
        If (person.BloodType = "A") Then
            Call bloodAPersons.Add(person)
        End If
    Next
    
    Dim replacedTemplate As String
    replacedTemplate = BuildTemplate_BloodA(bloodAPersons)
    BuildTemplate_Root = replacedTemplate
End Function

' 血液型Aのテンプレートを展開する
Private Function BuildTemplate_BloodA(persons As Collection) As String
    
    ' 子のテンプレートを展開する
    Dim replacedTemplate_Men As String
    Dim replacedTemplate_Women As String
    Dim count As Long
    count = 0
    
    Dim person As PersonData
    For Each person In persons
        If (person.Gender = "男") Then
            If (replacedTemplate_Men <> "") Then
                replacedTemplate_Men = replacedTemplate_Men & NEW_LINE
            End If
            replacedTemplate_Men = replacedTemplate_Men & BuildTemplate_BloodA_Men(person)
        ElseIf (person.Gender = "女") Then
            If (replacedTemplate_Women <> "") Then
                replacedTemplate_Women = replacedTemplate_Women & NEW_LINE
            End If
            replacedTemplate_Women = replacedTemplate_Women & BuildTemplate_BloodA_Women(person)
        End If
        count = count + 1
    Next
    
    ' 子テンプレートにインデントを加える
    replacedTemplate_Men = ApplyIndent(replacedTemplate_Men, eIndentLevel.Level1)
    replacedTemplate_Women = ApplyIndent(replacedTemplate_Women, eIndentLevel.Level1)
    
    ' テンプレートを取得する
    Dim template As String
    template = SZZ_TemplateSheetAccessor.GetTempate(eTemplateRowPoisition.BloodA)
    
    ' プレースホルダーを設定する
    Dim params As Dictionary
    Set params = New Dictionary
    Debug.Print (replacedTemplate_Men)
    Call params.Add("血液型A男性リスト", replacedTemplate_Men)
    Call params.Add("血液型A女性リスト", replacedTemplate_Women)
    Call params.Add("血液型Aの人数", count)
    
    ' テンプレートを展開する
    Dim replacedTemplate As String
    replacedTemplate = BuildTemplate(template, params)
    BuildTemplate_BloodA = replacedTemplate
    Debug.Print
End Function

' 血液型A_男性のテンプレートを展開する
Private Function BuildTemplate_BloodA_Men(person As PersonData) As String
    
    ' テンプレートを取得する
    Dim template As String
    template = SZZ_TemplateSheetAccessor.GetTempate(eTemplateRowPoisition.BloodA_Man)
    
    ' プレースホルダーを設定する
    Dim params As Dictionary
    Set params = New Dictionary
    Call params.Add("名前", person.Name)
    Call params.Add("ひらがな", person.NameKana)
    Call params.Add("年齢", person.Age)
    Call params.Add("職業", person.BirthDate)
    Call params.Add("電話番号", person.Phone)
    
    ' テンプレートを展開する
    Dim replacedTemplate As String
    replacedTemplate = BuildTemplate(template, params)
    BuildTemplate_BloodA_Men = replacedTemplate
End Function

' 血液型A_女性のテンプレートを展開する
Private Function BuildTemplate_BloodA_Women(person As PersonData) As String
    
    ' テンプレートを取得する
    Dim template As String
    template = SZZ_TemplateSheetAccessor.GetTempate(eTemplateRowPoisition.BloodA_Woman)
    
    ' プレースホルダーを設定する
    Dim params As Dictionary
    Set params = New Dictionary
    Call params.Add("名前", person.Name)
    Call params.Add("ひらがな", person.NameKana)
    Call params.Add("年齢", person.Age)
    Call params.Add("マイナンバーカード", person.MyNumber)
    Call params.Add("メールアドレス", person.Email)
    
    ' テンプレートを展開する
    Dim replacedTemplate As String
    replacedTemplate = BuildTemplate(template, params)
    BuildTemplate_BloodA_Women = replacedTemplate
End Function

Option Explicit

Private Const TARGET_SHEET_NAME  As String = "テンプレート"
Private Const TEMPLATE_COLUMN_POSITION = 2

Public Enum eTemplateRowPoisition
    All = 1
    BloodA
    BloodB
    BloodO
    BloodAB
    BloodA_Man
    BloodA_Woman
    BloodB_Man
    BloodB_Woman
    BloodO_Man
    BloodO_Woman
    BloodAB_Man
    BloodAB_Woman
End Enum

' テンプレートを取得する
Public Function GetTempate(templateRowPosition As eTemplateRowPoisition) As String
    Dim ws As Worksheet
    Set ws = ThisWorkbook.Worksheets(TARGET_SHEET_NAME)
    GetTempate = ws.Cells(templateRowPosition, TEMPLATE_COLUMN_POSITION)
End Function