diff --git a/機能仕様書作成.xlsm b/機能仕様書作成.xlsm index 64df4ff..5109258 100644 Binary files a/機能仕様書作成.xlsm and b/機能仕様書作成.xlsm differ diff --git a/機能仕様書作成/Module1.bas b/機能仕様書作成/Module1.bas index ff4687a..ba74a47 100644 --- a/機能仕様書作成/Module1.bas +++ b/機能仕様書作成/Module1.bas @@ -57,7 +57,7 @@ Sub ExportCustomizeFunctionsToMarkdownFile() '======================== ' 種別見出し処理 '======================== - If categoryPos.exists(category) Then + If categoryPos.Exists(category) Then insertPos = categoryPos(category) Else md = md & "## " & category & vbCrLf & vbCrLf diff --git a/機能仕様書作成/Module3.bas b/機能仕様書作成/Module3.bas new file mode 100644 index 0000000..1de8d00 --- /dev/null +++ b/機能仕様書作成/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 \ No newline at end of file