script_dev/機能仕様書作成/Module1.bas

Attribute VB_Name = "Module1"
Option Explicit

Sub ExportCustomizeFunctionsToMarkdownFile()

    Dim ws As Worksheet
    Set ws = Worksheets("カスタマイズ機能")

    Dim lastRow As Long
    lastRow = ws.Cells(ws.Rows.Count, "C").End(xlUp).row

    Dim md As String
    Dim funcCounter As Long
    funcCounter = 1

    ' 種別ごとの最後の挿入位置
    Dim categoryPos As Object
    Set categoryPos = CreateObject("Scripting.Dictionary")

    ' 一覧表用（機能ID単位で集約）
    ' value = 機能名 || 対応要件ID（<br>連結）
    Dim summary As Object
    Set summary = CreateObject("Scripting.Dictionary")

    Dim r As Long
    
    Dim headerCell As Range
    Dim startRow As Long
    
    md = md & "# " & Trim(ws.Cells(2, "C").Value) & vbCrLf & vbCrLf
    
    Set headerCell = ws.Columns("D").Find( _
                        What:="機能名", _
                        LookAt:=xlWhole, _
                        LookIn:=xlValues)
    
    If headerCell Is Nothing Then
        MsgBox "「機能名」という見出しが見つかりません。", vbCritical
        Exit Sub
    End If
    
    startRow = headerCell.row + 1
    
    For r = startRow To lastRow
        ' ここに既存の処理


        Dim category As String
        Dim funcName As String
        Dim funcID As String
        Dim insertPos As Long

        category = Trim(ws.Cells(r, "C").Value)
        funcName = Trim(ws.Cells(r, "D").Value)
        funcID = "SRQ_FUN_" & Format(funcCounter, "000")

        '========================
        ' 種別見出し処理
        '========================
        If categoryPos.Exists(category) Then
            insertPos = categoryPos(category)
        Else
            md = md & "## " & category & vbCrLf & vbCrLf
            insertPos = Len(md)
            categoryPos.Add category, insertPos
        End If

        '========================
        ' 機能ブロック生成
        '========================
        Dim block As String
        block = "### " & funcName & " " & funcID & vbCrLf & vbCrLf
        block = block & "#### 対応要件" & vbCrLf

        '========================
        ' B列：対応要件ID（vbLf確定）
        '========================
        Dim reqText As String
        reqText = ws.Cells(r, "B").Value
        reqText = Replace(reqText, vbCrLf, vbLf)
        reqText = Replace(reqText, Chr(13), vbLf)

        Dim reqArr As Variant
        reqArr = Split(reqText, vbLf)

        Dim i As Long
        Dim reqForTable As String
        reqForTable = ""

        For i = LBound(reqArr) To UBound(reqArr)
            If Trim(reqArr(i)) <> "" Then
                block = block & "* " & Trim(reqArr(i)) & vbCrLf
                If reqForTable <> "" Then reqForTable = reqForTable & "<br>"
                reqForTable = reqForTable & Trim(reqArr(i))
            End If
        Next i

        block = block & vbCrLf & "#### 機能概要" & vbCrLf

        '========================
        ' E列：機能概要
        '========================
        Dim descText As String
        descText = ws.Cells(r, "E").Value
        descText = Replace(descText, vbCrLf, vbLf)
        descText = Replace(descText, Chr(13), vbLf)

        Dim descArr As Variant
        descArr = Split(descText, vbLf)

        For i = LBound(descArr) To UBound(descArr)
        
            If Trim(descArr(i)) <> "" Then
        
                Dim indentLevel As Long
                Dim lineText As String
                Dim ch As String
                Dim pos As Long
                Dim indentPrefix As String
        
                indentLevel = 0
                lineText = descArr(i)
        
                ' 先頭のスペース／矢印をカウント
                For pos = 1 To Len(lineText)
                    ch = Mid(lineText, pos, 1)
                    If ch = " " Or ch = "　" Or ch = "→" Or ch = "・" Then
                        indentLevel = indentLevel + 1
                    Else
                        Exit For
                    End If
                Next pos
        
                ' 先頭記号を除去
                lineText = Mid(lineText, indentLevel + 1)
        
                ' Markdown 用インデント（1レベル = 半角2スペース）
                indentPrefix = String(indentLevel * 2, " ")
        
                block = block & indentPrefix & "* " & Trim(lineText) & vbCrLf
            End If
        
        Next i

        block = block & vbCrLf

        '========================
        ' Markdownへ挿入
        '========================
        md = Left(md, insertPos) & block & Mid(md, insertPos + 1)
        categoryPos(category) = insertPos + Len(block)

        '========================
        ' 一覧表データ登録（1機能1行）
        '========================
        summary.Add funcID, funcName & "||" & reqForTable

        funcCounter = funcCounter + 1

    Next r

    '========================
    ' 一覧表出力
    '========================
    md = md & "---" & vbCrLf & vbCrLf
    md = md & "## 機能ID・対応要件一覧" & vbCrLf & vbCrLf
    md = md & "| 機能ID | 機能名 | 対応要件ID |" & vbCrLf
    md = md & "|--------|--------|------------|" & vbCrLf

    Dim key As Variant, vals As Variant
    For Each key In summary.Keys
        vals = Split(summary(key), "||")
        md = md & "| " & key & " | " & vals(0) & " | " & vals(1) & " |" & vbCrLf
    Next key

    '========================
    ' Markdownファイル出力
    '========================
    Dim stream As Object
    Set stream = CreateObject("ADODB.Stream")

    Dim path As String
    path = ThisWorkbook.path & "\CustomizeFunctions.md"
    
    With stream
        .Type = 2                 ' adTypeText
        .Charset = "UTF-8"        ' ★ UTF-8指定
        .Open
        .WriteText md
        .SaveToFile path, 2       ' adSaveCreateOverWrite
        .Close
    End With

    MsgBox "Markdownファイルを出力しました：" & vbCrLf & path, vbInformation

End Sub