[ExcelVBA] コードの行数を調べる

>Blog Top Page >[ExcelVBA] Top Page >[ExcelVBA] ExcelVBA ALL >[ExcelVBA] AdventCalendar

アドベントカレンダー 1日目

今日はすごい捗ったなぁ。。
なんて日があってどれくらいの行数書いたんだろ？
なんて思うことありますよね。

はい。
あります。

ということで、行数を調べてみます。
VBE側のVBProjectというオブジェクトにアクセスできればわかります。
ただ、デフォルトではアクセスすることができないので
VBProjectにアクセスできるようにしましょう。

※以下はoffice2003の場合です
Excelのメニューバーで
[ツール]→[マクロ]→[セキュリティ]を選択
セキュリティのウィンドウが開いたら
[信頼できる発行元]のタブを選択
Visual Basic プロジェクトへのアクセスを信頼する
にチェックを入れます。

なんでデフォルトでアクセスできないかって？
そりゃ、コードの書き換えとかもできちゃうんで、全コード削除から
悪さをするコードの挿入までできちゃうので、任意で管理してくださいね。
っていうことです。


では、さっそくコードです。

view plainprint?

1. Option Explicit  
2.   
3. Sub SampleCode()  
4.     Dim ComponentName   As String  
5.     Dim i               As Integer  
6.     Dim SplitData       As Variant  
7.       
8.     With ThisWorkbook.VBProject  
9.         For i = 1 To .VBComponents.Count  
10.               
11.             ComponentName = .VBComponents(i).Name  
12.               
13.             With .VBComponents(ComponentName).CodeModule  
14.                   
15.                 SplitData = Split(.Lines(1, .CountOfLines), vbCrLf)  
16.                 Debug.Print ComponentName & ":" & UBound(SplitData)  
17.               
18.             End With  
19.         Next  
20.     End With  
21. End Sub  

Option Explicit

Sub SampleCode()
    Dim ComponentName   As String
    Dim i               As Integer
    Dim SplitData       As Variant
    
    With ThisWorkbook.VBProject
        For i = 1 To .VBComponents.Count
            
            ComponentName = .VBComponents(i).Name
            
            With .VBComponents(ComponentName).CodeModule
                
                SplitData = Split(.Lines(1, .CountOfLines), vbCrLf)
                Debug.Print ComponentName & ":" & UBound(SplitData)
            
            End With
        Next
    End With
End Sub

やっていることは、各コンポーネントオブジェクト(モジュールとかクラスとか)をループで取り出し
それらの全コードを改行でスプリットすることで桁数を割り出しているだけです。


実行するとコンポーネント名(シート名、モジュール名、クラス名などなど)と共に各行数が出力されます。

ThisWorkbook:8
Sheet1:1
Sheet2:1
Sheet3:1
Code1:852
SampleCode:20
Code2:11600

ちょっと見栄えば悪いですね。
見栄えを整えてみましょうか。
コンポーネント名は左揃え、行数は右揃えにしてみましょう

view plainprint?

1. Option Explicit  
2.   
3. Sub SampleCode()  
4.     Dim ComponentName       As String  
5.     Dim ComponentLineData   As New Collection  
6.     Dim FormatStyle1        As String  
7.     Dim FormatStyle2        As String  
8.     Dim i                   As Integer  
9.     Dim MaxStringLen        As Integer  
10.     Dim MaxValueLen         As Integer  
11.     Dim SplitData           As Variant  
12.       
13.     With ThisWorkbook.VBProject  
14.         For i = 1 To .VBComponents.Count  
15.             'コンポーネント名を取得  
16.             ComponentName = .VBComponents(i).Name  
17.               
18.             With .VBComponents(ComponentName).CodeModule  
19.                   
20.                 SplitData = Split(.Lines(1, .CountOfLines), vbCrLf)  
21.                   
22.                 ComponentLineData.Add Array(ComponentName, UBound(SplitData))  
23.           
24.                 'コンポーネント名で最大文字数を取得  
25.                 If MaxStringLen < Len(ComponentName) Then _  
26.                                 MaxStringLen = Len(ComponentName)  
27.   
28.                 '行数の桁数で最大文字数を取得  
29.                 If MaxValueLen < Len(CStr(UBound(SplitData))) Then _  
30.                                 MaxValueLen = Len(CStr(UBound(SplitData)))  
31.             End With  
32.         Next  
33.     End With  
34.       
35.     'コンポーネント名は左揃え、行数は右揃えにする  
36.     FormatStyle1 = "!" & String(MaxStringLen, "@")  
37.     FormatStyle2 = String(MaxValueLen, "@")  
38.       
39.     For i = 1 To ComponentLineData.Count  
40.         Debug.Print Format(ComponentLineData.Item(i)(0), FormatStyle1) & ":" & Format(ComponentLineData.Item(i)(1), FormatStyle2)  
41.     Next  
42.       
43.       
44.     Set ComponentLineData = Nothing  
45. End Sub  

Option Explicit

Sub SampleCode()
    Dim ComponentName       As String
    Dim ComponentLineData   As New Collection
    Dim FormatStyle1        As String
    Dim FormatStyle2        As String
    Dim i                   As Integer
    Dim MaxStringLen        As Integer
    Dim MaxValueLen         As Integer
    Dim SplitData           As Variant
    
    With ThisWorkbook.VBProject
        For i = 1 To .VBComponents.Count
            'コンポーネント名を取得
            ComponentName = .VBComponents(i).Name
            
            With .VBComponents(ComponentName).CodeModule
                
                SplitData = Split(.Lines(1, .CountOfLines), vbCrLf)
                
                ComponentLineData.Add Array(ComponentName, UBound(SplitData))
        
                'コンポーネント名で最大文字数を取得
                If MaxStringLen < Len(ComponentName) Then _
                                MaxStringLen = Len(ComponentName)

                '行数の桁数で最大文字数を取得
                If MaxValueLen < Len(CStr(UBound(SplitData))) Then _
                                MaxValueLen = Len(CStr(UBound(SplitData)))
            End With
        Next
    End With
    
    'コンポーネント名は左揃え、行数は右揃えにする
    FormatStyle1 = "!" & String(MaxStringLen, "@")
    FormatStyle2 = String(MaxValueLen, "@")
    
    For i = 1 To ComponentLineData.Count
        Debug.Print Format(ComponentLineData.Item(i)(0), FormatStyle1) & ":" & Format(ComponentLineData.Item(i)(1), FormatStyle2)
    Next
    
    
    Set ComponentLineData = Nothing
End Sub

実行結果は以下の通りです。

ThisWorkbook:    8
Sheet1      :    1
Sheet2      :    1
Sheet3      :    1
Code1       :  852
SampleCode  :   44
Code2       :11600

これなら見やすいですね！

>Blog Top Page >[ExcelVBA] Top Page >[ExcelVBA] ExcelVBA ALL >[ExcelVBA] AdventCalendar