正規表現を使ってステップ数カウント

正規表現を使ってソースファイルのステップ数をカウントしてみたいと思います。方法としては、ソースファイルに対して、1行ずつ読み込んでいきます。読み込んだ1行分の文字列は正規表現で除外パターン(コメント行など)を検索します。除外パターンが存在しない場合はステップ数をカウントアップします。存在する場合は除外する行なのでカウントアップしません。これをソースファイルの末尾まで行いステップ数を求めるようにします。また、正常にカウントされているか確認するため、読み込んだ文字列とマッチ結果をセルに出力します。除外パターンが存在する場合は「除外」と出力し、存在しない場合はステップ数のカウント番号を出力します。なお、読み込んだ文字列の出力に関しては、先頭行の「'」やタブやスペースも出力するため、文字列の置き換えも行いました。先頭行が「'」だったら「''」、半角スペースだったら{s}、全角スペースだったら{S}、タブだったら{t}というように置き換えます。



↓以下プログラムです。

Option Explicit

Sub stepCnt()
     
    '-------------------------------
    ' 事前準備
    '-------------------------------
    'FileSystemObject生成
    Dim objFS As FileSystemObject
    Set objFS = CreateObject("Scripting.FileSystemObject")
    
    'A1セルの文字列を取得
    Dim fPath As String
    fPath = Cells(1, "B").Value
    
    'ファイル存在チェック
    If objFS.FileExists(fPath) = False Or fPath = "" Then
        MsgBox "ファイルが存在しません"
        Set objFS = Nothing
    End If
    
    'A2セルより除外パターンを取得
    Dim dPattern As String
    dPattern = Cells(2, "B").Value
    
    '-------------------------------
    ' 検索パターンの設定
    '-------------------------------
    'RegExpオブジェクト生成
    Dim objRE As RegExp
    Set objRE = CreateObject("VBScript.RegExp")
    
    '除外パターンの設定
    objRE.Pattern = dPattern
    objRE.IgnoreCase = True '大文字・小文字を区別しない
    
    '-------------------------------
    ' カウント処理
    '-------------------------------
    'TextStreamオブジェクト取得(ファイルオープン)
    Dim objTS As TextStream
    Set objTS = objFS.OpenTextFile(fPath, ForReading)
    Set objFS = Nothing 'FileSystemObjectは解放しておく
    
    'ファイルを末尾まで読み込む
    Dim lineStr As String
    Dim stepCnt As Integer
    stepCnt = 0
    Dim y As Integer
    y = 7
    Do While objTS.AtEndOfStream = False
        lineStr = objTS.ReadLine    '1行読み込み
        
        'excel上のセルにソースを出力させるための処理
        Dim wkStr As String
        wkStr = Replace(lineStr, vbTab, "{t}")  'タブを{t}に置換
        wkStr = Replace(wkStr, " ", "{s}")  '半角スペースを{s}に置換
        wkStr = Replace(wkStr, " ", "{S}")  '全角スペースを{S}に置換
        If Left(wkStr, 1) = "'" Then    '先頭に「'」がある場合は「''」に置換
            wkStr = Replace(wkStr, "'", "''", 1, 1)
        End If
        Cells(y, 2).Value = wkStr 'ソースをセルに出力
        
        '除外パターンに一致した場合
        If objRE.Test(lineStr) = True Then
            Cells(y, 1).Value = "除外" 'セル上のソースの横に「除外」を出力
        Else
        '除外パターンに一致しない場合
            stepCnt = stepCnt + 1   'ステップ数カウントアップ
            Cells(y, 1).Value = stepCnt 'セル上のソースの横にカウント番号を出力
            Cells(5, "B").Value = stepCnt   'B5セルにカウント数を表示
        End If
        y = y + 1
    Loop
    
    '-------------------------------
    ' 終了処理
    '-------------------------------
    objTS.Close 'ファイルを閉じる
    Set objRE = Nothing 'RegExpオブジェクトを解放
    Set objTS = Nothing 'TextStreamオブジェクトを解放
    MsgBox "完了しました。"

End Sub