'作成：2006/07/22 渡辺真 '更新：2006/07/24 trimを使って左寄せすることで、あいまいなInStrを減らし、簡単にする。 '更新：2006/07/25 途中からコメント「'」の場合、コメント部を削除。 ' Sub 名が継続行(右端_)の対応追加。 '更新：2006/08/05 変数の宣言の場所を別表に追加 '更新：2006/08/12 変数の抽出の漏れを追加★★部。Property名取得追加 '更新：2006/08/20 recursive コール(再帰呼出し)の戻り時の変数出力の重複防止 '更新：2013/03/06 このブックのパスをデフォルトにする Option Explicit Dim ファイル名一覧(100) As String '一応、扱えるモジュール数は100ファイルとする。 Dim 変数名一覧(1000, 2) As String '一応、扱える変数数は1,000個とする。 Dim i As Integer Dim j As Integer Dim パス名 As String Dim ファイル数 As Integer Dim 変数№ As Integer Dim 開始桁 As Integer Dim 行データ As String Dim 開始時刻 As Variant Dim 終了時刻 As Variant Dim 重複 As Integer Dim 変数名文字数 As Integer Dim Sub名 As String Dim Function名 As String Dim 直前Sub名 As String Dim 直前Function名 As String Dim Property名 As String Dim 直前Property名 As String Dim 対応数 As Integer Dim プロシージャ区分 As String Dim モジュール名 As String Dim 変数宣言一覧順位 As Integer '**************************************************** '******* ★★ メイン・フロー ★★ ******** Sub 変数リスト作成() '**************************************************** Call ファイル一覧取得 開始時刻 = Now() Application.ScreenUpdating = False '処理速度向上のため画面更新を停止 Call 変数一覧取得 Call 変数Sub対応取得 Application.ScreenUpdating = True '画面更新停止を再開 終了時刻 = Now() MsgBox "処理が終了しました。" & Chr(13) & _ "処理時間は、" & Format(終了時刻 - 開始時刻, "nn分ss秒") & " でした。", vbOKOnly End Sub '******************************************** '*****************★★★********************* ' 指定したフォルダ内のファイルの一覧を取得 Private Sub ファイル一覧取得() '******************************************** ChDrive ThisWorkbook.Path ChDir ThisWorkbook.Path 'Excelでお仕事！(Excel全般の解説サイト) 'http://www.asahi-net.or.jp/~ef2o-inue/ '「フォルダ内のファイル一覧の取得」VBAの、部分修正版です。 Const ファイル名ワイルドカード = "\*.*" Dim パス桁数 As Integer Dim ファイル名 As String パス名 = Application.GetOpenFilename("VBAエクスポートモジュール,*.bas;*.cls") If パス名 = "False" Then End ' MsgBox パス名 For i = 1 To Len(パス名) If InStr(i, パス名, "\") <> 0 Then パス桁数 = InStr(i, パス名, "\") End If Next i パス名 = Left(パス名, パス桁数) ' 先頭のファイル名の取得 ファイル名 = Dir(パス名 & ファイル名ワイルドカード, vbNormal) ' ③ ' ファイルが見つからなくなるまで繰り返す ファイル数 = 0 Do While ファイル名 <> "" ' ④ ' 行を加算 ファイル数 = ファイル数 + 1 ' 先頭は1行目 'Cells(行, 1).Value = ファイル名 ' ⑤ ファイル名一覧(ファイル数) = ファイル名 ' ⑤ ' 次のファイル名を取得 ファイル名 = Dir() ' ⑥ Loop End Sub '******************************************** '*****************★★★********************* Private Sub 変数一覧取得() '******************************************** 変数№ = 1 変数宣言一覧順位 = 0 プロシージャ区分 = "Module" Worksheets("変数宣言一覧").Activate Cells.Select Selection.ClearContents Range("A1").Select Range("A1").Value = "№" Range("B1").Value = "モジュール名" Range("C1").Value = "Sub名" Range("D1").Value = "Function名" Range("E1").Value = "Property名" Range("F1").Value = "変数名" For i = 1 To ファイル数 If Right(ファイル名一覧(i), 3) = "bas" Or Right(ファイル名一覧(i), 3) = "cls" Then '******************************** 'ファイルのオープン。 Open パス名 & ファイル名一覧(i) For Input As #1 '*************データの読み込み*********** While (EOF(1) = 0) Line Input #1, 行データ 行データ = Trim(行データ) '2006/07/24★★★★ '************************ ここから、コメント削除 *************** If Left(行データ, 1) <> "'" And 行データ <> "" Then 'コメント行や空白行は、飛ばす。 If InStr(行データ, "'") <> 0 Then 行データ = Left(行データ, InStr(行データ, "'") - 2) '途中のコメント以降をカット End If '************************ ここから、Exit行の削除 *************** If Left(行データ, 13) <> "Exit Function" _ And Left(行データ, 8) <> "Exit Sub" Then '************************ ここまで、不要行の削除 *************** '************************ ここから、変数宣言の単純出力用 ******* Call プロシージャ名取得 '************************ ここまで、変数宣言の単純出力用 ******* If Left(行データ, 4) = "Dim " Then 開始桁 = 5 Call 変数名取得 'Stop ElseIf Left(行データ, 7) = "Public " _ And Left(行データ, 11) <> "Public Sub " _ And Left(行データ, 13) <> "Public Const " _ And Left(行データ, 16) <> "Public Function " _ And Left(行データ, 15) <> "Public Declare " _ And Left(行データ, 16) <> "Public Property " Then 開始桁 = 8 Call 変数名取得 ElseIf Left(行データ, 7) = "Global " Then 開始桁 = 8 Call 変数名取得 'Stop ElseIf Left(行データ, 6) = "Const " Then 開始桁 = 7 If InStr(開始桁, 行データ, " ") <> 0 Then 変数名文字数 = InStr(開始桁, 行データ, " ") - 開始桁 End If Call 変数名重複チェック End If End If '行データが、「Exit Sub」「Exit Function」以外 End If 'コメント行以外 Wend '**************終了処理********************* Close #1 'Stop End If Next i 'モジュールファイルを「ファイル数」だけ読み込み続ける。 '以下、変数宣言一覧シートの整形 Worksheets("変数宣言一覧").Activate Cells.Select Cells.EntireColumn.AutoFit Range("A1").Select Selection.AutoFilter Range("C2").Select ActiveWindow.FreezePanes = True Range("B2").Select End Sub '******************************************** '*************変数宣言の単純出力用*************** Private Sub プロシージャ名取得() If Left(行データ, 7) = "End Sub" Or Left(行データ, 12) = "End Function" _ Or Left(行データ, 5) = "GoSub" Then プロシージャ区分 = "Module" ElseIf InStr(行データ, "Sub ") <> 0 _ And Right(行データ, 4) <> " Sub" _ And InStr(行データ, Chr(34) & "Sub ") = 0 _ And InStr(行データ, "Sub " & Chr(34)) = 0 Then 'Subの後ろの空白まで含めてチェックして、subを含む単語を除外。行の最後がSubは対象外。 ' "Sub や Sub " も除外 プロシージャ区分 = "Sub" 開始桁 = InStr(行データ, "Sub") + 4 Call Sub名取得 ElseIf InStr(行データ, "Function ") <> 0 _ And Right(行データ, 9) <> " Function" _ And InStr(行データ, Chr(34) & "Function ") = 0 _ And InStr(行データ, "Function " & Chr(34)) = 0 Then プロシージャ区分 = "Function" 開始桁 = InStr(行データ, "Function") + 9 Call Function名取得 ElseIf Left(行データ, 16) = "Public Property " Then プロシージャ区分 = "Property" 開始桁 = InStr(行データ, "Property") + 9 Call Property名取得 End If ' Stop End Sub '******************************************** '******************************************** Private Sub 変数名取得() If InStr(開始桁, 行データ, "(") <> 0 Then 変数名文字数 = InStr(開始桁, 行データ, "(") - 開始桁 + 1 '配列変数の場合は、「(」までを変数名として取得する。 ElseIf InStr(開始桁, 行データ, ",") <> 0 Then '変数の宣言を「,」で2つ、つなげている場合の「,」より前。 If InStr(開始桁, 行データ, " ") < InStr(開始桁, 行データ, ",") Then 変数名文字数 = InStr(開始桁, 行データ, " ") - 開始桁 Else 変数名文字数 = InStr(開始桁, 行データ, ",") - 開始桁 End If Call 変数名重複チェック '変数の宣言を「,」で2つ、つなげている場合の「,」より後ろ。 開始桁 = InStr(開始桁, 行データ, ",") + 2 ' Stop Call 変数名取得 'recursive コール(再帰呼出し) ElseIf InStr(開始桁, 行データ, " ") <> 0 Then 変数名文字数 = InStr(開始桁, 行データ, " ") - 開始桁 Else 変数名文字数 = Len(行データ) - 開始桁 + 1 End If ' Stop Call 変数名重複チェック End Sub '******************************************** '******************************************** Private Sub 変数名重複チェック() 重複 = 0 For j = 1 To 変数№ If 変数名一覧(j, 1) = Mid(行データ, 開始桁, 変数名文字数) Then 重複 = 1 Exit For End If Next j If 重複 = 0 Then 変数名一覧(変数№, 1) = Mid(行データ, 開始桁, 変数名文字数) 変数名一覧(変数№, 2) = ファイル名一覧(i) 変数№ = 変数№ + 1 End If '★★★以下は変数宣言の単純出力用★★★ Worksheets("変数宣言一覧").Activate '*******************recursive コール(再帰呼出し)の戻り時の重複防止2008/08/20 If Range("F2").Cells(変数宣言一覧順位, 1).Value <> Mid(行データ, 開始桁, 変数名文字数) _ Or Range("B2").Cells(変数宣言一覧順位, 1).Value <> ファイル名一覧(i) _ Or Range("C2").Cells(変数宣言一覧順位, 1).Value <> Sub名 _ Or Range("D2").Cells(変数宣言一覧順位, 1).Value <> Function名 _ Or Range("E2").Cells(変数宣言一覧順位, 1).Value <> Property名 _ Then 変数宣言一覧順位 = 変数宣言一覧順位 + 1 Range("A2").Cells(変数宣言一覧順位, 1).Value = 変数宣言一覧順位 Range("B2").Cells(変数宣言一覧順位, 1).Value = ファイル名一覧(i) ' If カッコ削除 = 1 Then 変数名文字数 = 変数名文字数 - 1 Range("F2").Cells(変数宣言一覧順位, 1).Value = Mid(行データ, 開始桁, 変数名文字数) ' カッコ削除 = 0 Select Case プロシージャ区分 Case "Module" Case "Sub" Range("C2").Cells(変数宣言一覧順位, 1).Value = Sub名 Case "Function" Range("D2").Cells(変数宣言一覧順位, 1).Value = Function名 Case "Property" Range("E2").Cells(変数宣言一覧順位, 1).Value = Property名 End Select End If ' If 変数№ > 13 Then Stop End Sub '******************************************** '*****************★★★********************* Private Sub 変数Sub対応取得() '******************************************** Dim 検索前対応数 As Integer Dim 行 As Integer Worksheets("変数とSubの対応表").Activate Cells.Select Selection.ClearContents Range("A1").Select Range("A1").Value = "№" Range("B1").Value = "変数名" Range("C1").Value = "モジュール名" Range("D1").Value = "Sub名" Range("E1").Value = "Function名" Range("F1").Value = "Property名" 対応数 = 1 ' For j = 1 To 5 For j = 1 To 変数№ - 1 '★★★★★★★★★★★ 検索前対応数 = 対応数 For i = 1 To ファイル数 If Right(ファイル名一覧(i), 3) = "bas" Or Right(ファイル名一覧(i), 3) = "cls" Then '******************************** 'ファイルのオープン。 Open パス名 & ファイル名一覧(i) For Input As #1 '*************データの読み込み*********** 行 = 0 Sub名 = "" 直前Sub名 = "" Function名 = "" 直前Function名 = "" Property名 = "" 直前Property名 = "" While (EOF(1) = 0) Line Input #1, 行データ 行データ = Trim(行データ) '2006/07/24★★★★ '************************ ここから、コメント削除 *************** If Left(行データ, 1) <> "'" And 行データ <> "" Then 'コメント行や空白行は、飛ばす。 If InStr(行データ, "'") <> 0 Then 行データ = Left(行データ, InStr(行データ, "'") - 2) '途中のコメント以降をカット End If '************************ ここまで、コメント削除 *************** 行 = 行 + 1 'プロシージャ名とプロシージャ区分取得：Sub If Left(行データ, 4) = "Sub " Then 開始桁 = 5 プロシージャ区分 = "Sub" Call Sub名取得 End If If Left(行データ, 12) = "Private Sub " Then 開始桁 = 13 プロシージャ区分 = "Sub" Call Sub名取得 End If If Left(行データ, 11) = "Public Sub " Then 開始桁 = 12 プロシージャ区分 = "Sub" Call Sub名取得 End If 'プロシージャ名とプロシージャ区分取得：Function If Left(行データ, 9) = "Function " Then 開始桁 = 10 プロシージャ区分 = "Function" Call Function名取得 End If If Left(行データ, 16) = "Public Function " Then 開始桁 = 17 プロシージャ区分 = "Function" Call Function名取得 End If If Left(行データ, 17) = "Private Function " Then 開始桁 = 18 プロシージャ区分 = "Function" Call Function名取得 End If 'プロシージャ名とプロシージャ区分取得：Property If Left(行データ, 9) = "Property " Then 開始桁 = 10 プロシージャ区分 = "Property" Call Property名取得 End If If Left(行データ, 16) = "Public Property " Then 開始桁 = 17 プロシージャ区分 = "Property" Call Property名取得 End If '変数の使われているプロシージャを取得 '行頭がDimの行は対象外 If Left(行データ, 4) <> "Dim " Then If Right(変数名一覧(j, 1), 1) = "(" Then '配列変数の場合 Call 配列変数対応取得 Else '配列変数以外の場合 Call 一般変数対応取得 End If End If ' If 行 > 50 Then Stop '★★★★★★ ' If 変数名一覧(j) = "k" Then Application.ScreenUpdating = True: Stop End If 'コメント行以外 Wend '**************終了処理********************* Close #1 End If Next i 'モジュールファイルを「ファイル数」だけ読み込み続ける。 ' Stop If 対応数 = 検索前対応数 Then Range("A2").Cells(対応数, 1) = 対応数 Range("B2").Cells(対応数, 1) = 変数名一覧(j, 1) Range("C2").Cells(対応数, 1) = "★ " & 変数名一覧(j, 2) & " ★で、変数の宣言は有りますが、どのモジュールでも、使われていません。★" 対応数 = 対応数 + 1 End If Next j '変数№1から最後(変数№)まで繰り返す。 Cells.Select Cells.EntireColumn.AutoFit Range("A1").Select Selection.AutoFilter Range("C1").Select 'ファイルサイズ Selection.ColumnWidth = 20 Range("C2").Select ActiveWindow.FreezePanes = True Range("B2").Select 'Stop End Sub '******************************************** '******************************************** Private Sub Sub名取得() If Right(行データ, 1) <> "_" Then Sub名 = Mid(行データ, 開始桁, InStr(開始桁, 行データ, ")") - 開始桁 + 1) Else Sub名 = Mid(行データ, 開始桁, InStr(開始桁, 行データ, " ") - 開始桁) End If End Sub '******************************************** '******************************************** Private Sub Function名取得() If Right(行データ, 1) <> "_" Then Function名 = Mid(行データ, 開始桁, InStr(開始桁, 行データ, "(") - 開始桁) Else Function名 = Mid(行データ, 開始桁, InStr(開始桁, 行データ, " ") - 開始桁) End If End Sub '******************************************** '******************************************** Private Sub Property名取得() If Right(行データ, 1) <> "_" Then Property名 = Mid(行データ, 開始桁, InStr(開始桁, 行データ, "(") - 開始桁) Else Property名 = Mid(行データ, 開始桁, InStr(開始桁, 行データ, " ") - 開始桁) End If End Sub '******************************************** '******************************************** Private Sub 配列変数対応取得() '変数を、行データと照合する方法。 '(1)．配列変数の場合は、 ' ①．行頭の場合は、ずばり一致 ' ②．行中の場合は、前に空白 ' ③．もしくは行中の場合は、前に( If (Left(行データ, Len(変数名一覧(j, 1))) = 変数名一覧(j, 1) _ Or InStr(行データ, " " & 変数名一覧(j, 1)) <> 0 _ Or InStr(行データ, "(" & 変数名一覧(j, 1)) <> 0) _ And (直前Sub名 <> Sub名 Or 直前Function名 <> Function名) Then Range("A2").Cells(対応数, 1) = 対応数 Range("B2").Cells(対応数, 1) = 変数名一覧(j, 1) Range("C2").Cells(対応数, 1) = ファイル名一覧(i) If プロシージャ区分 = "Sub" Then Range("D2").Cells(対応数, 1) = Sub名 直前Sub名 = Sub名 ElseIf プロシージャ区分 = "Function" Then Range("E2").Cells(対応数, 1) = Function名 直前Function名 = Function名 ElseIf プロシージャ区分 = "Function" Then Range("F2").Cells(対応数, 1) = Property名 直前Property名 = Property名 End If 対応数 = 対応数 + 1 End If End Sub '******************************************** '******************************************** Private Sub 一般変数対応取得() '(2)．配列変数で無い場合は、 ' ①．行頭の場合は、後ろに空白 ' ②．行中の場合は、前後に空白 ' ③．もしくは行中の場合は、前に(、後ろに空白 ' ④．もしくは行中の場合は、前に(、後ろに, ★ ' ⑤．もしくは行中の場合は、前に空白、後ろに)★ ' ⑥．もしくは行中の場合は、前に(、後ろに)★★ ' ⑦．もしくは行中の場合は、前に空白、後ろに,★ ' ⑧．もしくは行中の場合は、前に空白、後ろに.★★ ' ⑨．行末の場合は、前に空白 If (Left(行データ, Len(変数名一覧(j, 1)) + 1) = 変数名一覧(j, 1) & " " _ Or InStr(行データ, " " & 変数名一覧(j, 1) & " ") <> 0 _ Or InStr(行データ, "(" & 変数名一覧(j, 1) & " ") <> 0 _ Or InStr(行データ, "(" & 変数名一覧(j, 1) & ",") <> 0 _ Or InStr(行データ, " " & 変数名一覧(j, 1) & ")") <> 0 _ Or InStr(行データ, "(" & 変数名一覧(j, 1) & ")") <> 0 _ Or InStr(行データ, " " & 変数名一覧(j, 1) & ",") <> 0 _ Or InStr(行データ, " " & 変数名一覧(j, 1) & ".") <> 0 _ Or Right(行データ, Len(変数名一覧(j, 1)) + 1) = " " & 変数名一覧(j, 1)) _ And ((プロシージャ区分 = "Sub" And 直前Sub名 <> Sub名) _ Or (プロシージャ区分 = "Function" And 直前Function名 <> Function名) _ Or (プロシージャ区分 = "Property" And 直前Property名 <> Property名)) Then Range("A2").Cells(対応数, 1) = 対応数 Range("B2").Cells(対応数, 1) = 変数名一覧(j, 1) Range("C2").Cells(対応数, 1) = ファイル名一覧(i) If プロシージャ区分 = "Sub" Then Range("D2").Cells(対応数, 1) = Sub名 直前Sub名 = Sub名 ElseIf プロシージャ区分 = "Function" Then Range("E2").Cells(対応数, 1) = Function名 直前Function名 = Function名 ElseIf プロシージャ区分 = "Property" Then Range("F2").Cells(対応数, 1) = Property名 直前Property名 = Property名 End If 対応数 = 対応数 + 1 End If End Sub '********************************************
