VBA関数一覧を作成するマクロ | エクセルマクロ(VBA)実践蔵(じっせんぐら)
- エクセルマクロ(VBA)実践蔵 >
- 項目一覧 >
- VBA関数一覧を作成するマクロ
VBA関数一覧を作成するマクロ最終更新日：2023-07-22
VBAのマクロコードを正規表現を使用して解析し、関数一覧を作成するマクロ
出力される関数一覧
引数と戻り値の行数は、エクセルのグループ化機能を使用しています。
画像の赤丸部分をクリックすると、一斉に折りたたんだ状態にできます。
折りたたんだ場合は、戻り値や引数は非表示となります。
逆に、全展開をするには、下図の赤丸部分をクリックすると、全表示となります。
入力情報
Visual Basic Editorからコードをコピーして貼り付けたシートを入力情報としています。
マクロの解説
関数リスト作成の呼び出し
ソースを貼り付けているシートと出力先シートのシートオブジェクトを引数に呼び出します。
Sub 関数リスト作成の呼び出し()
Call 関数リスト作成(ThisWorkbook.Worksheets("InPut"), _
ThisWorkbook.Worksheets("Out"))
End Sub関数リスト作成マクロ
メイン処理になります。実行される概要は下記になります。
呼び出している初期化処理内で、①入力シートの複製 ②出力シートのデータ全クリア ③出力シートのグループ化初期設定 ④コードの成型 を行っています。
④の成型で入力シートのデータに対して、変更を加えているため、連続してデバックするために、シートの複製を行い、その複製したシートを入力シートとして扱って成型し、最後に削除しています。②は、結果を常に同じシートに出力させていたので、前の実行結果を消去しています。
④の成型は、行末に『_』(アンダーバー)が存在する場合は、下の行と連結しています。これは、VBA特有のコード内の途中改行を一行にまとめています。また、コードではないコメントとダブルクォーテーションで囲まれている文字列部分の消去を行っています。
他の言語(CやJava)の場合：C言語の行を跨ぐコメントの削除として「/*」を見つけたら「*/」が見つかるまで削除することと、文字列が存在する行は、「;」(セミコロン)又は「{」(中括弧開き)が行末に入るように成型すれば、関数宣言のフォーマットを統一できるかと思います。
入力コードのフォーマットを先に統一することで、関数名を抽出するコードを簡略化できます。
成型が完了したら、VBAは関数名を「Sub又はFunction 任意の文字列 $(行末)」で検索して探しています。関数名は「(」(丸括弧開始記号)までとし、引数を「,」(カンマ)又は「)」(丸括弧閉じ記号)を区切り文字として取得しています。
最後に、スペースでSplitして変数名と型名の取得を行っています。
C言語の場合は、関数の先頭を型名又はvoidにする必要があることと、行末は「{」(中括弧開き)を条件にすれば、プロトタイプ宣言を拾わずに済むと思います。
次に、新しい関数を見つけたり、入力データが終了の場合、直前の関数に対して、グループ化の設定を行っています。
Sub 関数リスト作成(inWSht As Worksheet, oWSht As Worksheet)
Dim Rng As Range '入力シートの1セル
Dim findStr As String '関数フォーマット(正規表現)
Dim readStr As String '関数フォーマットと一致した文字列
Dim getText As String '取り出した文字列
Dim pos As Long '関数Sub/Functionの開始位置
Dim chkPt As Long '『（』丸い開始括弧の位置
Dim 引数cnt As Long '引数を数える変数
Dim splitArr 'split結果格納変数
'グループ化用変数
Dim GrpStRow As Long, GrpEdRow As Long
'出力行数
Dim outRow As Long
'入力シートの複製、出力シートの初期化
'入力シートのコメント削除、文字列削除
Call 初期化処理(inWSht, oWSht)
'出力行数を初期化
outRow = 1
'グループ化開始行数を初期化
GrpStRow = 0
'関数名を探すフォーマット
findStr = "(Sub|Function)" & ".*" & "$"
'すべてのデータでループ(A列のみが前提)
For Each Rng In inWSht.UsedRange
'セルの文字列を取得
readStr = Rng.Value
'正規表現検索 関数名探す
pos = RExp_InStr(1, readStr, findStr)
If pos > 0 Then
'見つけた位置の左は読み飛ばす ひとまずprivateやpublicは出力させてません
readStr = Right(readStr, Len(readStr) - pos + 1)
'Subという単語を見つけたら削除(変数名にSubがついていても対象にならないように考慮)
readStr = RExp_Replace(readStr, "(\s|^)" & "Sub" & "(\s|$)", "", False)
'Functionという単語を見つけたら削除
readStr = RExp_Replace(readStr, "(\s|^)" & "Function" & "(\s|$)", "", False)
'『（』丸い開始括弧の位置を取得
chkPt = InStr(1, readStr, "(", vbTextCompare)
If chkPt > 0 Then
'新しい関数名を見つけた場合
'グループ化開始行数に値が設定済みの場合
'(前に見つけた関数に引数や戻り値があった場合)
If GrpStRow > 0 Then
'一つ前の行をグループの最終行に設定する
GrpEdRow = outRow - 1
'念のためのチェック
If GrpStRow > 0 And GrpEdRow > 0 Then
'グループ化する
oWSht.Rows(GrpStRow & ":" & GrpEdRow).Group
End If
End If
'関数名の取り出し
getText = Left(readStr, chkPt - 1)
'行頭のスペースは削除
getText = RExp_Replace(getText, "^\s+", "", True)
'A列に文字列"関数名"を出力し、"B列"に関数名を出力
oWSht.Cells(outRow, 1).Value = "関数名"
oWSht.Cells(outRow, 2).Value = getText
'出力行数を一つ加算
outRow = outRow + 1
'引数の数を数える変数とグループ化開始行数の初期化
引数cnt = 0
GrpStRow = 0
'読み終わった分を消去
getText = Left(readStr, chkPt)
readStr = Replace(readStr, getText, "", , , vbTextCompare)
'引数の出力 引数に配列がある場合、一旦括弧を変更
readStr = Replace(readStr, "()", "[]", , , vbTextCompare)
'区切り文字を探す
'カンマ、行末、丸括弧閉じ記号『）』、セル内改行を探す
chkPt = RExp_InStr(1, readStr, "(,|$|\)|\n)")
Do While Not chkPt = 0
'区切り文字が見つかる間は、ループ
getText = RExp_FindStr(1, readStr, "(,|$|\)|\n)")
If getText = "" Then
'行末の場合
getText = readStr
Else
'区切り文字を検出した場合、区切り文字を外す
getText = Left(readStr, chkPt - 1)
End If
If Not getText = "" Then
'引数、又は、戻り値を見つけた場合
'グループ化の開始位置を設定
If 引数cnt = 0 Then
GrpStRow = outRow
End If
If getText = readStr Then
'区切り文字が行末なら戻り値
'行頭のスペースは削除
getText = RExp_Replace(getText, "^\s+", "", True)
'B列に文字列"戻り値"を出力し、C列に型を出力する
oWSht.Cells(outRow, 2).Value = "戻り値"
'getTextは、As □□
getText = Replace(getText, "As ", "", , , vbTextCompare)
oWSht.Cells(outRow, 3).Value = getText
outRow = outRow + 1
Else
'行頭のスペースは削除
getText = RExp_Replace(getText, "^\s+", "", True)
'引数の数を更新
引数cnt = 引数cnt + 1
'B列に文字列"引数"と番号を出力し、C列に引数名を出力する
oWSht.Cells(outRow, 2).Value = "引数" & 引数cnt
'引数の配列括弧を元に戻す（なければスルー）
getText = Replace(getText, "[]", "()", , , vbTextCompare)
'スペースでスプリット
splitArr = Split(getText, " ", , vbTextCompare)
If UBound(splitArr) = 5 And splitArr(0) = "Optional" Then
'getTextは、Optional ○○ As □□ = △△
'(0)="Optional",(1)=○○,(2)="As",(3)=□□, (4)="=", (5)=△△
'C列に型、D列に引数名を出力
oWSht.Cells(outRow, 3).Value = splitArr(3)
oWSht.Cells(outRow, 4).Value = splitArr(1)
oWSht.Cells(outRow, 5).Value = splitArr(5)
outRow = outRow + 1
ElseIf UBound(splitArr) = 3 And _
(splitArr(0) = "ByVal" Or splitArr(0) = "ByRef") Then
'getTextは、ByVal ○○ As □□
'getTextは、ByRef ○○ As □□
If splitArr(0) = "ByRef" Then
'E列にByRefを出力
oWSht.Cells(outRow, 5).Value = splitArr(0)
End If
'C列に型、D列に引数名を出力
oWSht.Cells(outRow, 3).Value = splitArr(3)
oWSht.Cells(outRow, 4).Value = splitArr(1)
outRow = outRow + 1
ElseIf UBound(splitArr) = 2 Then
'getTextは、○○ As □□
'splitArr(0)=○○,splitArr(1)="As",splitArr(2)=□□
'C列に型、D列に引数名を出力
oWSht.Cells(outRow, 3).Value = splitArr(2)
oWSht.Cells(outRow, 4).Value = splitArr(0)
outRow = outRow + 1
Else
'そのまま出力
oWSht.Cells(outRow, 3).Value = getText
outRow = outRow + 1
End If
End If
Else
End If
'読み終わった分を消去
getText = Left(readStr, chkPt)
readStr = Replace(readStr, getText, "", , 1, vbTextCompare)
'次の区切り文字まで読み出し
chkPt = RExp_InStr(1, readStr, "(,|$|\)|\n)")
Loop
End If
End If
Next
'みつけた最後の関数のグループ化を行う
If GrpStRow > 0 Then
'最終出力行数を取得
GrpEdRow = outRow - 1
If GrpStRow > 0 And GrpEdRow > 0 Then
'グループ化
oWSht.Rows(GrpStRow & ":" & GrpEdRow).Group
End If
End If
'警告を表示しない
Application.DisplayAlerts = False
'複製した入力シートを削除
inWSht.Delete
'警告を表示する
Application.DisplayAlerts = True
'メモリ解放
Set inWSht = Nothing
Set Rng = Nothing
End Sub上記で使用している関数「初期化処理」は、このあとに記載します。RExp_InStr、RExp_Replace、RExp_FindStrについては、別ページの「文字列操作・正規表現」に記述されているものを使用しています。
初期化処理
入力シートの複製、グループ化したときの＋－が表示される位置を上付きに設定し、VBAマクロ特有のアンダーバーによる改行を排除する関数「連結解除」を呼び出し、関数の開始を検出するために不要なコード内の文字列やコメントを削除する関数を呼び出しています。
初期化処理で呼び出している関数は、そのまま続けて記述しています。
Sub 初期化処理(ByRef inWSht As Worksheet, oWSht As Worksheet)
'編集するために入力データのシートを複製
inWSht.Copy after:=inWSht
'複製した入力データシートのオブジェクトを取得
Set inWSht = ActiveSheet
'出力シートを初期化
oWSht.UsedRange.Clear
'グループ化解除
oWSht.Rows.ClearOutline
'アウトラインの上付き設定
oWSht.Outline.SummaryRow = xlAbove
Call 連結解除(inWSht)
Call 文字列削除(inWSht)
Call コメント文削除(inWSht)
End Sub
Sub 連結解除(inWSht As Worksheet)
Dim Rng As Range
Dim nextLine As String
Dim getText As String
'すべてのデータでループ
For Each Rng In inWSht.UsedRange
'行末に"_"がついていたら、上のセルに連結してまとめる
Do While RExp_InStr(1, Rng.Value, "_$")
'行末のアンダーバーを削除
getText = RExp_Replace(Rng.Value, "_$", "", True)
'一つ下の文字列を取得
nextLine = Rng.Offset(1, 0).Value
'行頭のスペースを削除
nextLine = RExp_Replace(nextLine, "^\s+", "", True)
'文字列の連結
Rng.Value = getText & nextLine
'一つ下の行を削除
inWSht.Rows(Rng.Row + 1).Delete
Loop
Next
Set Rng = Nothing
End Sub上記で呼び出している関数RExp_InStrと、RExp_Replaceは、関数リスト作成から呼び出しているものと同じです。
Sub 文字列削除(inWSht As Worksheet)
Dim Rng As Range
Dim chkPt As Long
Dim findStr As String
'ダブルクォーテーションで囲まれている文字列を削除
findStr = "(\""+\""+|\""+.*\""+)"
'すべてのデータでループ
For Each Rng In inWSht.UsedRange
'ダブルクォーテーションを正規表現で検索する
chkPt = RExp_InStr(1, Rng.Value, findStr)
'見つけ続ける限りループする
Do While Not chkPt = 0
'先頭のみ置換する 置換文字列は存在しない文字列"%$#"
Rng.Value = RExp_Replace(Rng.Value, findStr, "%$#", False)
'次を探す
chkPt = RExp_InStr(1, Rng.Value, findStr)
Loop
'ダブルクォーテーションで囲まれている文字列は、すべて削除し、ダブルクォーテーションのみとする
Rng.Value = Replace(Rng.Value, "%$#", """""", , , vbTextCompare)
Next
Set Rng = Nothing
End Subダブルクォーテーションは２つセットで、見つけた順に変換をかけて処理していきます。（でないと、一行にダブルクォーテーションが4つ存在した場合、2つ目と3つ目でも一致してしまう。その組み合わせを一致と判断させないため先頭から一致する2つづつで処理する。）
上記で呼び出している関数RExp_InStrと、RExp_Replaceは、関数リスト作成から呼び出しているものと同じです。
Sub コメント文削除(inWSht As Worksheet)
Dim Rng As Range
Dim findStr As String
'コメント開始記号を探す
findStr = "'.*$"
'すべてのデータでループ
For Each Rng In inWSht.UsedRange
'正規表現置換で見つかった文字列を削除
Rng.Value = RExp_Replace(Rng.PrefixCharacter & Rng.Value, findStr, "", True)
Next
Set Rng = Nothing
End Sub
上記で呼び出している関数RExp_Replaceは、関数リスト作成から呼び出しているものと同じです。