ExcelファイルのGrep検索マクロ

この記事を読むのに必要な時間は約 22 分です。

たくさんのファイルの中身をまとめて検索するには、Grepですよね。

 

サクラエディタや秀丸エディタなど、エディタに付いている機能の１つです。

 

でもサクラエディタなどでExcelファイルをGrepしても、まともに探すことが出来ません。
バイナリデータだから・・・。

 

なので、ExcelファイルもGrep出来るツールがあります。

 

ところが、そんな便利ツールもセキュリティにうるさい企業だと、ダウンロードして自分のPCに入れることが禁止されていたりします。

 

数千もあるExcelを一つひとつ開いて検索するのはイヤですよね。

 

そんな職場でもExcelファイルをGrepしたい！！

 

というわけで、Excel VBAのマクロでGrepツールが作れるので書いてみました。

 

スポンサーリンク

Excel VBAでGrepするとこんな感じ

検索対象のフォルダとキーワードを指定して「ExcelGrep」ボタンを押してGrepします。

 

VBAでExcelGrep

 

キーワードを含むセルが一覧に表示されます。

VBAでExcelGrep

 

Grep検索マクロでやっていること

Excel Grepマクロの中でやっていることはシンプルです。

 

  1. エラーチェック
  2. 一覧をクリア
  3. 指定したパス内のExcelファイルを全検索
  4. サブフォルダも再帰的にファイル検索
  5. 見つかったExcelファイルの各シートから、キーワードに一致する文字列を全検索
  6. 見つかったら、その都度キーワードを含むセルの内容を一覧に記載
  7. 罫線を引く

 

片っ端からExcelファイルを開いて検索を繰り返して、見つかる度にセルの位置や内容を一覧に書いていく、ただそれだけです。

Grepのソースコード

シートに入れるGrepボタンと、ボタンをクリックしたとき動作するものとだけ分けて書きました。

 

このソースコードでGrepを試してみたいとき、やり方が分からない場合は

Excel VBAで抽選するマクロを作ってみる｜乱数の範囲を動的に指定して抽出

の記事が見本になります。

 

ボタンの入れ方やソースコードをどこに貼り付けるのか、参考にしてみてください。

 

シートの枠

下の表は、”Grep”シートのものです。
Ａ１セルから貼り付けて、セルの幅を調整すれば大丈夫です。
ExcelファイルをGrepするマクロ
ルートパス
キーワード
No パス ファイル名 シート名 セル位置 セル内容

 

貼り付ければ下図のようなセルの配置になります。

VBAでExcelGrep

 

シート側

ボタンを作って右クリックから、ソースコードの表示をすれば、ボタンをクリックしたときの処理が勝手に出来ます。

 

そこから「Call grepMain」でメイン関数を呼びます。

Private Sub GrepButton_Click()
    Call grepMain
End Sub

 

Grepのメイン

基本的にそのまま貼り付けて貰えば大丈夫ですが、３か所だけ注意点があります。

 

  • ３行目にシート名を書いています。”Grep”というところが実際のシート名と一致している必要があります。
  • １５行目に検索対象のフォルダのパスを書いています。セルの位置と一致する必要があります。
  • １６行目にキーワードを書いています。これもセルの位置と一致する必要があります。

 

Option Explicit

Public Const STR_GREP_SHEET_NAME As String = "Grep"
Public sMsgString As String
Public sFilePathRoot As String
Public sKeyWord As String
Public lcnt As Long


'Grepメイン関数
Public Sub grepMain()
    Dim bErrFlag As Boolean
    bErrFlag = False
    
    sFilePathRoot = ThisWorkbook.Sheets(STR_GREP_SHEET_NAME).Cells(4, 5).Value
    sKeyWord = ThisWorkbook.Sheets(STR_GREP_SHEET_NAME).Cells(5, 5).Value

    'エラーチェック
    bErrFlag = inputCheck

    If bErrFlag = False Then

        '描画をいったんオフ
        Application.ScreenUpdating = False
    
        '一覧をクリア
        Call clearCells
    
        If Right(sFilePathRoot, 1) <> "\" Then
            sFilePathRoot = sFilePathRoot & "\"
        
        End If
    
        lcnt = 8
        
        'ExcelファイルのGrep
        Call openExcelFiles(sFilePathRoot)
        
        '罫線を引く
        Call addLines
        
        '描画をオン
        Application.ScreenUpdating = True
        
        sMsgString = "Grepが完了しました！！"
    
    End If
    
    'メッセージ出力
    MsgBox sMsgString
    
End Sub


'入力内容チェック
Private Function inputCheck() As Boolean
    inputCheck = False
    If sKeyWord = "" Then
        sMsgString = "キーワードが入力されていません"
        inputCheck = True
    End If
End Function


'指定したフォルダ内のエクセルファイルを全検索
Private Sub openExcelFiles(ByVal sFilePath As String)
    
    Dim lSheetNo As Long
    Dim sTmpPath As String
    Dim oFSO As Object
    
    If Right(sFilePath, 1) <> "\" Then
        sFilePath = sFilePath & "\"
    End If
    
    'Dirで見つかったファイル名を取得
    sTmpPath = Dir(sFilePath & "*.xls")
    
    'エラーが発生しても、次の行の処理から続行する設定
    On Error Resume Next

    '同じフォルダ内でエクセルファイルが見つかる限り検索
    Do While sTmpPath <> ""
        
        '読み取り専用、更新なしで開く
        Workbooks.Open sFilePath & sTmpPath, UpdateLinks:=0, ReadOnly:=1 , Password:=""
        
            '全シートループ
            For lSheetNo = 1 To Worksheets.Count
            
                'シート内をGrep
                Call grepExcelSheet(sFilePath, sTmpPath, lSheetNo)
                
            Next lSheetNo
        
        '確認メッセージを表示せず閉じる
        Workbooks(sTmpPath).Close Application.DisplayAlerts = False
        
        sTmpPath = Dir()
    
    Loop

    '「On Error Resume Next」の有効範囲がこの行までにする
    On Error GoTo 0

    'この関数自身を呼び出して、サブフォルダも再帰的に検索
    With CreateObject("Scripting.FileSystemObject")
        For Each oFSO In .GetFolder(sFilePath).SubFolders
            Call openExcelFiles(oFSO.Path)
        Next oFSO
    End With
    
    Set oFSO = Nothing

End Sub

'Excelのシート内をGrep
Private Sub grepExcelSheet(ByVal sFilePath As String, ByVal sTmpPath As String, ByVal lSheetNo As Long)

    Dim lCellRow As Long, lCellCol As Long
    Dim rFoundCell As Range, rFoundFirstCell As Range
    Dim rEndRange As Range
    Dim rTmpFoundCell As Range
    Dim sTmpSheetName As String
    

    With Workbooks(sTmpPath).Sheets(lSheetNo)
        
        'シート内1件目に見つかったセルを取得
        Set rTmpFoundCell = .Cells.Find(What:=sKeyWord, LookAt:=xlPart)
        
        '見つからなかったら関数を抜ける
        If rTmpFoundCell Is Nothing Then Exit Sub
        
        'シート名を取得
        sTmpSheetName = .Name
        
        '最初に見つかったセル情報を保持
        Set rFoundFirstCell = rTmpFoundCell
        
        Do
        
            '見つかったセルの情報を一覧に記載
            Call outputCellInfo(sTmpPath, sFilePath, sTmpSheetName, rTmpFoundCell)
        
            'シート内2件目以降に一致したやつ
            Set rTmpFoundCell = .Cells.FindNext(rTmpFoundCell)
        
        '見つかったセルが最初に見つかったセルと異なる間ループ
        Loop While rTmpFoundCell <> rFoundFirstCell
    
    End With

End Sub


'キーワードを含むセルの情報をアウトプット
Private Sub outputCellInfo(ByVal sTmpPath As String, ByVal sFilePath As String, ByVal sTmpSheetName As String, _
                                                                            ByVal rFoundCell As Range)
                                                                            
    With ThisWorkbook.Sheets(STR_GREP_SHEET_NAME)
        
        'No
        .Cells(lcnt, 2).Value = lcnt - 7
        
        'パス
        .Cells(lcnt, 3).Value = sFilePath
        
        'ファイル名
        .Cells(lcnt, 4).Value = sTmpPath
        
        'シート名
        .Cells(lcnt, 5).Value = sTmpSheetName
        
        'セルの位置
        .Cells(lcnt, 6).Value = convertRange(rFoundCell.Column) & rFoundCell.Row
        
        'キーワードを含むセルの内容
        .Cells(lcnt, 7).Value = rFoundCell.Value
        
    End With

    '次の行に繰り上げる
    lcnt = lcnt + 1

End Sub


'セルの位置を変換
Private Function convertRange(ByVal lCol As Long) As String
    convertRange = ""
    
    Dim lTmpCol As Long
    Dim lBuf As Long
    Dim sAsc As Long
    sAsc = 64
    
    If Len(lCol) = 0 Then Exit Function
    
    lTmpCol = lCol
    
    '1桁目を変換
    lBuf = sAsc + lTmpCol Mod 26
        
    convertRange = Chr(lBuf)
    
    lTmpCol = lTmpCol \ 26
    
    '2桁目を変換
    If lTmpCol Mod 26 >= 1 Then
        
        lBuf = sAsc + lTmpCol Mod 26
        convertRange = Chr(lBuf) & convertRange
        
    End If
    
    '3桁目を変換
    If lTmpCol \ 26 >= 1 Then
    
        lBuf = sAsc + lTmpCol \ 26
        convertRange = Chr(lBuf) & convertRange
        
    End If

End Function


'罫線を引く
Private Sub addLines()
    
    Dim lRow As Long
    
    '8行目以降を選択
    lRow = ThisWorkbook.Sheets(STR_GREP_SHEET_NAME).Cells(Rows.Count, 2).End(xlUp).Row
    
    '0件の場合は罫線を引かない
    If lRow < 8 Then Exit Sub
    
    Range("B8:G" & lRow).Select
    
    '最初に通常の罫線を引く
    With Selection.Borders()
    
        .LineStyle = xlContinuous
        .Weight = xlThin
    
    End With
    
    '内側の横方向の罫線だけ点線にする
    With Selection.Borders(xlInsideHorizontal)
    
        .LineStyle = xlContinuous
        .Weight = xlHairline
    
    End With
    
    Range("A1").Select
    
End Sub

'セルをクリア
Private Sub clearCells()

    '7行以下ならクリアしない
    If ActiveCell.SpecialCells(xlLastCell).Row < 8 Then
        Exit Sub
    End If

    '8行目以降をクリア
    Range("B8", ActiveCell.SpecialCells(xlLastCell)).Select
    Selection.Borders().LineStyle = xlLineStyleNone
    Selection.ClearFormats
    Selection.ClearContents
    Range("A1").Select
        
End Sub

 

スポンサーリンク

まとめ：VBAでExcelファイルをGrep検索するマクロ

ExcelファイルのGrepマクロでした。

 

誰かが作ったGrepのツールをダウンロード出来れば手っ取り早いと思いますが、セキュリティのためインターネットに繋がっていない職場もあったりします。

 

そんな時、ツールを自作出来れば便利ですよね。

 

自作と言っても、誰かが公開しているソースコードを見ながらそのまま書き込んで作るだけです。

 

よろしければ参考にどうぞ。