機能仕様書作成のVBAソースコードを追加
This commit is contained in:
193
機能仕様書作成/Module1.bas
Normal file
193
機能仕様書作成/Module1.bas
Normal file
@@ -0,0 +1,193 @@
|
||||
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 = "→" 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 fso As Object, file As Object
|
||||
Set fso = CreateObject("Scripting.FileSystemObject")
|
||||
|
||||
Dim path As String
|
||||
path = ThisWorkbook.path & "\CustomizeFunctions.md"
|
||||
|
||||
Set file = fso.CreateTextFile(path, True, True) ' UTF-8
|
||||
file.Write md
|
||||
file.Close
|
||||
|
||||
MsgBox "Markdownファイルを出力しました：" & vbCrLf & path, vbInformation
|
||||
|
||||
End Sub
|
||||
|
||||
|
||||
Reference in New Issue
Block a user