🎉
mael for VBA を列設定に対応させる

2025/06/29に公開
 前回の記事https://zenn.dev/yasumichi/articles/f818c61e12a574

 設定ファイルのフォーマットを考える前回の記事でも書いたが、YAML をパースするのは、少し骨が折れそうなので config\columns.xlsx という名前の Excel ブックで設定をできるようにする。
以下の設定はとりあえず対応しない。
global
duplicate_previous_for_blank
以下の項目を設定できるようにする。
Column name
type (increment, list, string)
value (increment の場合に使用する初期値)
alignment (left、center、right)
width

 最初に挿入する列の設定シート prepend で設定する。

 markdown ファイルに記述されている列の設定シート  column_conditions で設定する。

 最後に追加する列の設定シート append で設定する。

 ColumnCondition クラスの作成mael の mael/column_config.py  で定義されている ColumnCondition クラスを移植する。
''' <summary>Class ColumnCondition</summary>

Option Explicit

Public value_type As ValueType
Public initial_value As Long
Public width As Double
Public alignment As Long
Public maxCount As Long

''' <summary>Constructor</sammary>
Private Sub Class_Initialize()
    value_type = TYPE_STRING
    initial_value = 1
    width = 8.38
    alignment = xlLeft
    maxCount = 1
End Sub

''' <summary>public initializer</sammary>
''' <params id="title_">column title</param>
''' <params id="type_">column value type</param>
Public Sub Init(vtype As ValueType, width_ As Double, alignment_ As Long)
    value_type = vtype
    width = width_
    alignment = alignment_
End Sub

 プロパティ

プロパティ
役割


value_type
列の種別

initial_value
increment の初期値

alignment
水平方向の文字揃え

width
列の幅

maxCount
listの最大項目数(独自)

duplicate_previous_for_blank は、未実装。

 メソッド

メソッド
役割


Init
外部からクラスを初期化する


 ColumnConfig クラスの作成ColumnConfig  クラスを移植する。
移植と言いつつ、結構、独自実装になってしまった。
''' <summary>Class ColumnConfig</summary>
''' <remarks>
''' Requires
''' - Microsoft Scripting Runtime
''' </remarks>

Option Explicit

Public prepend_columns As Scripting.Dictionary
Public conditions As Scripting.Dictionary
Public append_columns As Scripting.Dictionary

''' <summary>default constructor</sammary>
Private Sub Class_Initialize()
    Set prepend_columns = New Scripting.Dictionary
    Set conditions = New Scripting.Dictionary
    Set append_columns = New Scripting.Dictionary
End Sub

''' <summary>list columns</sammary>
Public Function AllConditions() As Scripting.Dictionary
    Dim key As Variant
    Dim dict As New Scripting.Dictionary
    
    For Each key In prepend_columns.Keys
        dict.Add key, prepend_columns.item(key)
    Next
    
    For Each key In conditions.Keys
        dict.Add key, conditions.item(key)
    Next
    
    For Each key In append_columns.Keys
        dict.Add key, append_columns.item(key)
    Next

    Set AllConditions = dict
End Function

''' <summary>parse configuration of columns</sammary>
Public Sub Parse(configPath As String)
    Dim sh As Worksheet
    Dim coldic As Scripting.Dictionary
    Dim rowNumber As Long
    Dim colName As String
    Dim condition As ColumnCondition

    If Right(configPath, 5) <> ".xlsx" Then
        Debug.Print configPath & " is not supported."
        Exit Sub
    End If
    
    If Dir(configPath) = "" Then
        Debug.Print configPath & " is not exists."
        Exit Sub
    End If
    
    Application.ScreenUpdating = False
    
    With Workbooks.Open(configPath)
        With sh
        End With
        For Each sh In .Worksheets
            Set coldic = New Scripting.Dictionary
            With sh
                rowNumber = 2
                Do While .Cells(rowNumber, 1).Value <> ""
                    Set condition = New ColumnCondition
                    colName = .Cells(rowNumber, 1).Value
                    ' value_type
                    Select Case LCase(.Cells(rowNumber, 2).Value)
                    Case "increment"
                        condition.value_type = TYPE_INCREMENT
                        If .Cells(rowNumber, 3).Value <> "" Then
                            condition.initial_value = Val(.Cells(rowNumber, 3).Value)
                        End If
                    Case "list"
                        condition.value_type = TYPE_LIST
                    Case "string"
                        condition.value_type = TYPE_STRING
                    Case Else
                        condition.value_type = TYPE_STRING
                    End Select
                    
                    ' alignment
                    If .Cells(rowNumber, 4).Value <> "" Then
                        Select Case LCase(.Cells(rowNumber, 4).Value)
                        Case "left"
                            condition.alignment = xlLeft
                        Case "center"
                            condition.alignment = xlCenter
                        Case "right"
                            condition.alignment = xlRight
                        Case Else
                            condition.alignment = xlLeft
                        End Select
                    End If
                    
                    ' width
                    If .Cells(rowNumber, 5).Value <> "" Then
                        condition.width = Val(.Cells(rowNumber, 5).Value)
                    End If
                    
                    
                    coldic.Add colName, condition
                    rowNumber = rowNumber + 1
                    Set condition = Nothing
                Loop
                
            End With
            Select Case sh.Name
            Case "prepend"
                Set prepend_columns = coldic
            Case "column_conditions"
                Set conditions = coldic
            Case "append"
                Set append_columns = coldic
            End Select
            Set coldic = Nothing
        Next
        .Close
    End With
    
    Application.ScreenUpdating = True
End Sub

 プロパティ

プロパティ
役割


prepend_columns
最初に挿入する列の設定を保持する辞書

conditions
markdown ファイルに記述されている列の設定を保持する辞書

append_columns
最後に追加する列の設定を保持する辞書


 メソッド

メソッド
役割


AllConditions
すべての列の設定を取得する

Parse
設定ファイルから列の設定を読み込む


 テストコード動作確認用の簡単なテストコードを書く。
Sub TestParse()
    Dim config As New ColumnConfig
    Dim filePath As String
    Dim key As Variant
    Dim cond As ColumnCondition
    
    filePath = Application.GetOpenFilename
    
    'Debug.Print Replace(filePath, Dir(filePath), "")
    
    config.Parse (filePath)
    
    For Each key In config.prepend_columns.Keys
        Debug.Print CStr(key)
        Set cond = config.prepend_columns.item(key)
        Debug.Print "- " & cond.value_type
        Debug.Print "- " & cond.initial_value
        Debug.Print "- " & cond.alignment
        Debug.Print "- " & cond.width
    Next
    
    For Each key In config.conditions.Keys
        Debug.Print CStr(key)
        Set cond = config.conditions.item(key)
        Debug.Print "- " & cond.value_type
        Debug.Print "- " & cond.initial_value
        Debug.Print "- " & cond.alignment
        Debug.Print "- " & cond.width
    Next
    
    For Each key In config.append_columns.Keys
        Debug.Print CStr(key)
        Set cond = config.append_columns.item(key)
        Debug.Print "- " & cond.value_type
        Debug.Print "- " & cond.initial_value
        Debug.Print "- " & cond.alignment
        Debug.Print "- " & cond.width
    Next
End Sub
サンプル設定ファイルの場合は、以下の出力が得られた。
No.
- 1
- 1
- -4131
- 8.38
Categories
- 2
- 1
- -4108
- 8.38
Description
- 2
- 1
- -4131
- 50
Expected
- 2
- 1
- -4131
- 50
Result
- 2
- 1
- -4131
- 8.38
Timestamp
- 2
- 1
- -4131
- 8.38
Comment
- 2
- 1
- -4131
- 50

 ExcelBuilderModule の改良ColumnConfig クラスの生成は、Build プロシージャで行い、Convert プロシージャに渡すようにする。
Convert プロシージャの宣言を次のように修正する。
Sub Convert(ByVal filePath As String, ByVal config As ColumnConfig)

 markdown の表部分積み込み処理の改良        Dim steps As New Collection
        Dim stepDict As New Scripting.Dictionary
        Dim cond As ColumnCondition
        Dim item As StepItem
        Dim itemType As ValueType
        Dim title As String
        Set item = Nothing
        
        itemType = TYPE_STRING
        Do While True
            line = .ReadText(-2)
            
            If .EOS Then
                If Not item Is Nothing Then
                    stepDict.Add item.title, item.GetContent()
                End If
                If stepDict.Count > 0 Then
                    steps.Add stepDict
                End If
                Exit Do
            End If
            
            With New RegExp
                .Pattern = "^\s*---\s*$"
                If .Test(line) Then
                    If Not item Is Nothing Then
                        stepDict.Add item.title, item.GetContent()
                        If itemType = TYPE_LIST Then
                            If config.conditions.item(title).maxCount < item.GetContent().Count Then
                                config.conditions.item(title).maxCount = item.GetContent().Count
                            End If
                        End If
                        Set item = Nothing
                    End If
                    If stepDict.Count > 0 Then
                        steps.Add stepDict
                        Set stepDict = New Scripting.Dictionary
                    End If
                    GoTo CONTINUE
                End If
                
                .Pattern = "^#{3,}\s*(\S.*\S|\S)\s*$"
                Set mc = .Execute(line)
                If mc.Count > 0 Then
                    If Not item Is Nothing Then
                        stepDict.Add item.title, item.GetContent()
                        If itemType = TYPE_LIST Then
                            If config.conditions.item(title).maxCount < item.GetContent().Count Then
                                config.conditions.item(title).maxCount = item.GetContent().Count
                            End If
                        End If
                    End If
                    
                    title = mc(0).SubMatches(0)
                    If config.conditions.Exists(title) Then
                        itemType = config.conditions.item(title).value_type
                    Else
                        itemType = TYPE_STRING
                        Set cond = New ColumnCondition
                        config.conditions.Add title, cond
                    End If
                    
                    Set item = New StepItem
                    item.Init title, itemType
                    GoTo CONTINUE
                End If
                
                If Not item Is Nothing Then
                    If Len(Trim(line)) > 0 Then
                        item.AddContentLine (RTrim(line))
                    End If
                End If
            End With
            'Cells(rowNumber, 1).Value = line
            'rowNumber = rowNumber + 1]
CONTINUE:
        Loop

 列ヘッダーの処理を修正ColumnConfig クラスの AllConditions 関数からすべての列情報を取得し、処理する。
        ' column header
        Dim key As Variant
        Dim colNumber As Long
        colNumber = 1
        For Each key In config.AllConditions().Keys
            titleRow = rowNumber
            columns(colNumber).ColumnWidth = config.AllConditions().item(key).width
            With Cells(rowNumber, colNumber)
                .Value = key
                .Font.Bold = True
                .HorizontalAlignment = xlCenter
            End With
            colNumber = colNumber + 1
        Next

        maxCol = colNumber - 1
処理終了後、罫線を引く時のために最終列番号を maxCol に控えておく。

 表の内容の処理表の内容も ColumnConfig に対応させる。
        ' table body
        Dim obj As Object
        Dim content As Collection
        For Each stepDict In steps
            colNumber = 1
            For Each key In config.prepend_columns
                If config.prepend_columns.item(key).value_type = TYPE_INCREMENT Then
                    Cells(rowNumber, colNumber).Value = config.prepend_columns.item(key).initial_value
                    config.prepend_columns.item(key).initial_value = config.prepend_columns.item(key).initial_value + 1
                End If
                colNumber = colNumber + 1
            Next
            For Each key In config.conditions.Keys
                Select Case config.conditions.item(key).value_type
                Case TYPE_LIST
                    If stepDict.Exists(key) Then
                        Set content = stepDict.item(key)
                        listIndex = 1
                        If content.Count > 0 Then
                            For listIndex = 1 To content.Count
                                Cells(rowNumber, colNumber + listIndex - 1).Value = content.item(listIndex)
                            Next
                        End If
                    End If
                    colNumber = colNumber + config.conditions.item(key).maxCount
                Case TYPE_STRING
                    If stepDict.Exists(key) Then
                        Set content = stepDict.item(key)
                        Cells(rowNumber, colNumber).Value = JoinCollection(content)
                    End If
                    colNumber = colNumber + 1
                End Select
            Next
            rowNumber = rowNumber + 1
        Next

 罫線を引く処理の変更列ヘッダーの処理で保存した最終列番号を利用して罫線を引くように修正。
        ' format borders
        Dim index As Long
        With Range(Cells(titleRow, 1), Cells(rowNumber - 1, maxCol))
            For index = xlEdgeLeft To xlInsideHorizontal
                With .Borders(index)
                    .LineStyle = xlContinuous
                    .ColorIndex = 0
                    .TintAndShade = 0
                    .Weight = xlThin
                End With
            Next
        End With

 mael のサンプルシナリオを試してみるmael init . でテストケースを選択した際に作成される Scenario 1.md で試してみる。
Summary の内容に空行が出力されているので修正した。

 だいぶ見通しが悪くなってきた…次は、シート作成処理を別プロシージャーに分離することにしよう。

 ここまでの成果バージョン 0.2 として、プレリリースを公開した。
プロパティ	役割
value_type	列の種別
initial_value	increment の初期値
alignment	水平方向の文字揃え
width	列の幅
maxCount	listの最大項目数(独自)
メソッド	役割
Init	外部からクラスを初期化する
プロパティ	役割
prepend_columns	最初に挿入する列の設定を保持する辞書
conditions	markdown ファイルに記述されている列の設定を保持する辞書
append_columns	最後に追加する列の設定を保持する辞書
メソッド	役割
AllConditions	すべての列の設定を取得する
Parse	設定ファイルから列の設定を読み込む
GitHubで編集を提案
前回の記事

設定ファイルのフォーマットを考える

最初に挿入する列の設定

markdown ファイルに記述されている列の設定

最後に追加する列の設定

ColumnCondition クラスの作成

プロパティ

メソッド

ColumnConfig クラスの作成

プロパティ

メソッド

テストコード

ExcelBuilderModule の改良

markdown の表部分積み込み処理の改良

列ヘッダーの処理を修正

表の内容の処理

罫線を引く処理の変更

mael のサンプルシナリオを試してみる

だいぶ見通しが悪くなってきた…

ここまでの成果

Discussion
