マークダウンファイル生成スクリプト作成

機能仕様書作成/Module3.bas

@@ -0,0 +1,175 @@
+Sub ExportMarkdown_Complete()
+
+    '==============================
+    ' 0. 基本情報（変換定義側）
+    '==============================
+    Dim defWs As Worksheet
+    Set defWs = ThisWorkbook.Sheets("要求仕様書変換")
+
+    Dim sourcePath As String
+    sourcePath = defWs.Range("C3").Value          ' 取得元Excel
+
+    Dim sheetNames() As String
+    sheetNames = Split(defWs.Range("C4").Value, vbLf) ' 対象シート（改行区切り）
+
+    Dim startRow As Long
+    startRow = defWs.Range("B5").Value             ' 探索開始行
+
+    Dim title As String
+    title = defWs.Range("N3").Value                ' Markdownタイトル
+
+    Dim template As String
+    template = defWs.Range("M4").Value             ' Markdownテンプレート
+
+    '==============================
+    ' 1. 項目定義（B/C/F列）
+    '==============================
+    ' key   : B列（{B6} 等で使うキー）
+    ' value : Array(取得元列記号, 条件)
+    Dim items As Object
+    Set items = CreateObject("Scripting.Dictionary")
+
+    Dim defRow As Long
+    defRow = 6
+
+    Do While defWs.Cells(defRow, 2).Value <> ""
+        items.Add defWs.Cells(defRow, 2).Value, _
+                  Array(defWs.Cells(defRow, 3).Value, _
+                        defWs.Cells(defRow, 6).Value)
+        defRow = defRow + 1
+    Loop
+
+    '==============================
+    ' 2. 取得元 Excel を開く
+    '==============================
+    Dim srcWb As Workbook
+    Set srcWb = Workbooks.Open(sourcePath, ReadOnly:=True)
+
+    ' 種別まとめ用
+    Dim categoryMap As Object
+    Set categoryMap = CreateObject("Scripting.Dictionary")
+
+    ' 種別なしブロック
+    Dim normalBlocks As String
+    normalBlocks = ""
+
+    '==============================
+    ' 3. シート単位で処理
+    '==============================
+    Dim sn As Variant
+    For Each sn In sheetNames
+
+        Dim dataWs As Worksheet
+        Set dataWs = srcWb.Sheets(Trim(sn))
+
+        Dim r As Long
+        r = startRow
+
+        ' 最初の定義列が空になるまで
+        Do While dataWs.Cells(r, Columns(items.Items()(0)(0)).Column).Value <> ""
+
+            Dim md As String
+            md = template          ' ★ テンプレートを複製
+
+            Dim category As String
+            category = ""
+
+            Dim key As Variant
+            For Each key In items.Keys
+
+                Dim colLetter As String
+                Dim cond As String
+                colLetter = items(key)(0)
+                cond = items(key)(1)
+
+                Dim colNum As Long
+                colNum = Columns(colLetter).Column
+
+                Dim cellValue As String
+                cellValue = dataWs.Cells(r, colNum).Value
+
+                Select Case cond
+
+                    Case "箇条書き"
+                        Dim lines() As String
+                        lines = Split(cellValue, vbLf)
+
+                        Dim listText As String
+                        Dim i As Long
+                        For i = LBound(lines) To UBound(lines)
+                            If Trim(lines(i)) <> "" Then
+                                listText = listText & "- " & lines(i) & vbCrLf
+                            End If
+                        Next i
+                        cellValue = Trim(listText)
+
+                    Case "種別"
+                        category = cellValue
+                        cellValue = ""   ' テンプレートには出さない
+
+                    Case Else
+                        ' なし：そのまま使用
+                End Select
+
+                ' ★ テンプレート置換
+                md = Replace(md, "{" & key & "}", cellValue)
+
+            Next key
+
+            '==============================
+            ' 4. 種別ごとに格納
+            '==============================
+            If category <> "" Then
+                If categoryMap.Exists(category) Then
+                    categoryMap(category) = categoryMap(category) & vbCrLf & md
+                Else
+                    categoryMap.Add category, md
+                End If
+            Else
+                normalBlocks = normalBlocks & vbCrLf & md
+            End If
+
+            r = r + 1
+        Loop
+    Next sn
+
+    srcWb.Close False
+
+    '==============================
+    ' 5. Markdown 全体を生成
+    '==============================
+    Dim output As String
+    output = ""
+
+    ' タイトル
+    If title <> "" Then
+        output = "# " & title & vbCrLf & vbCrLf
+    End If
+
+    ' 種別ブロック
+    Dim cat As Variant
+    For Each cat In categoryMap.Keys
+        output = output & "## " & cat & vbCrLf & vbCrLf
+        output = output & categoryMap(cat) & vbCrLf & vbCrLf
+    Next cat
+
+    ' 種別なし
+    output = output & normalBlocks
+
+    '==============================
+    ' 6. Markdown ファイル生成
+    '==============================
+    Dim outPath As String
+    outPath = ThisWorkbook.Path & "\output.md"
+
+    Dim stream As Object
+    Set stream = CreateObject("ADODB.Stream")
+    stream.Charset = "UTF-8"
+    stream.Open
+    stream.WriteText output
+    stream.SaveToFile outPath, 2   ' 2 = 上書き
+    stream.Close
+
+    MsgBox "Markdownファイルを生成しました：" & vbCrLf & outPath, vbInformation
+
+End Sub