VBAでExcelファイルをGrep検索するマクロを書いてみた

更新日：2022年8月11日
公開日：2018年10月14日

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

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

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

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

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

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

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

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

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

目次（リンク）

1 Excel VBAでGrepするとこんな感じ
2 Grep検索マクロでやっていること
3 Grepのソースコード
4 まとめ：VBAでExcelファイルをGrep検索するマクロ

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

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

VBAでExcelGrep

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

VBAでExcelGrep

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

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

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

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

Grepのソースコード

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

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

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

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

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

シートの枠

下の表は、”Grep”シートのものです。
Ａ１セルから貼り付けて、セルの幅を調整すれば大丈夫です。

ExcelファイルをGrepするマクロ

ルートパス

キーワード

パス

ファイル名

シート名

セル位置

セル内容

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

VBAでExcelGrep

シート側

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

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

Private Sub GrepButton_Click()
    Call grepMain
End Sub

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

100

101

102

103

104

105

106

107

108

109

110

111

112

113

114

115

116

117

118

119

120

121

122

123

124

125

126

127

128

129

130

131

132

133

134

135

136

137

138

139

140

141

142

143

144

145

146

147

148

149

150

151

152

153

154

155

156

157

158

159

160

161

162

163

164

165

166

167

168

169

170

171

172

173

174

175

176

177

178

179

180

181

182

183

184

185

186

187

188

189

190

191

192

193

194

195

196

197

198

199

200

201

202

203

204

205

206

207

208

209

210

211

212

213

214

215

216

217

218

219

220

221

222

223

224

225

226

227

228

229

230

231

232

233

234

235

236

237

238

239

240

241

242

243

244

245

246

247

248

249

250

251

252

253

254

255

256

257

258

259

260

261

262

263

264

265

266

267

268

269

270

271

272

273

274

275

276

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

'見つかったセルの情報を一覧に記載

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

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

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

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

“VBAでExcelファイルをGrep検索するマクロを書いてみた” への24件のフィードバック

ひろかず より:

2021年11月5日 5:02 PM

Grepで複数のファイルから検索を初めて行いました
上手くできて感動しています。

一つアドバイスを頂きたいのですが、ファイルの「D列」のみ検索したい場合は
どの行を、どう修正すればよいのでしょうか？
もしお時間があるときにご教示ねがいます。

返信
1. espresso8 より:
  
  2021年12月16日 11:21 PM
  
  ひろかずさん
  コメントありがとうございます！
  返信までかなり時間が空いてしまい申し訳ありません。
  
  D列のみに検索範囲を絞るやり方もあるとは思うのですが、書き方が分からずです・・・。
  私のソースだと、outputCellInfo で見つけた場合に書き込んでいますので、
  D列だったらoutputCellInfo を実行するよう、IF文などで条件分岐すれば、
  とりあえず意図した結果を得られるとは思います。
  D列以外も検索してしまうので、処理は遅くなってしまいますが＾＾；
  
  返信
KAI より:

2022年7月11日 3:05 PM

VBA入門者です。偶然こちらのコードを見つけて利用させていただきました。UIも設定できて見やすく使いやすいです。

もしよろしければ一つご教授いただきたいのですが、
ファイルパスを出力しているセル(C列)にハイパーリンクを付与して、検索先のファイルのセルにとべるように書き換えてみたいのですが、可能でしょうか。

とても有用性の高いマクロで非常に助かっています。
なので、もしこの機能を付加できるのであれば、恐縮ですが教えていただければ幸いです。

返信
1. espresso8 より:
  
  2022年7月12日 10:52 PM
  
  KAI さん
  コメントありがとうございます！
  このマクロのソースが役立ったようで嬉しいです！！
  
  ハイパーリンクの付与ですが、
  例えば、マクロを実行しているExcelファイルのSheet1シートのC1セルに、
  他のブックのシートとセルを指定してハイパーリンクを付与する場合、
  次のように書けばリングを貼れます。
  
  With ThisWorkbook.Sheets(“Sheet1”)
  .Hyperlinks.Add .Range(“C1”), “C:\temp\test01.xlsx”, “Sheet2!E3”
  End With
  
  C1のところやファイル名、シート名を変数にすれば、
  動的にリンクを貼れるかと思います。
  
  不明点などあれば、またご質問いただければと思います。
  返事が遅れたらすみません。。。
  
  返信
  1. KAI より:
    
    2022年7月14日 12:12 AM
    
    espresso8様、お返事いただきありがとうございます。
    頂いた情報を基に色々と変更を加えてみたのですが、いくつか不明な点が出てきたので、またご指導のほどを賜りたく思います。
    
    まず初めに、今回はC8以降のC列の”パスの項目”のセルに、動的にリンクをつけようと思うのですが、その場合は返信でいただいたコードの2行目を、本コードの161行目に追加してから、変数をいろいろ追加するという感じでOKなのでしょうか。
    
    その前提で、以下のように書き換えてみました。
    .Hyperlinks.Add.Range (“C & lcnt”), “sFilePath & sTmpPath”, “sTmpSheetName & ! & convertRange(rFoundCell.Column) & rFoundCell.Row”
    
    これで実行してみたのですが、セルにはハイパーリンクがつきませんでした…
    恐れ入りますが、よろしければもう一度お教えいただきたく存じます。
    念のために目標としていることをもう少し詳しく言語化させていただきますと、「検索結果が出力されるC8以降のC列セル(パスの項目)に、検索先のセルへと飛べるようにハイパーリンクを設定する」という感じです。
    
    返信
    1. espresso8 より:
      
      2022年7月14日 7:50 PM
      
      さっそく試しているんですね。
      考え方は合っています！
      
      書き換えた
      .Hyperlinks.Add.Range (“C & lcnt”), “sFilePath & sTmpPath”, “sTmpSheetName & ! & convertRange(rFoundCell.Column) & rFoundCell.Row”
      を見たところ、変数と文字列が混同されているように感じました。
      
      VBAの場合、ダブルクォーテーション「”」で囲まれたところは文字列として扱われます。
      lcnt、sFilePath、sTmpPath　などは変数としてソースを書いていたはずなんですが、
      “C & lcnt”と書くと、C & lcnt　という文字列として扱われてしまいます。
      
      “C” & lcnt と書けば、C列の想定された位置を表せます。
      上記のように書いていても、Long型のlcnt を勝手にString型にして”C”とくっつけてくれると思いますが、
      “C” & CStr(lcnt) のように明示的にString型にするほうが良いかもしれません。
      
      後ろの部分もほぼ変数なのでダブルクォーテーションを取って、「!」の部分だけは文字列にしたいので、次のようにしたら良いかと思います。
      .Hyperlinks.Add.Range(“C” & CStr(lcnt)), sFilePath & sTmpPath, sTmpSheetName & “!” & convertRange(rFoundCell.Column) & rFoundCell.Row
      
      これで上手く動くでしょうか。
      
      返信
      1. KAI より:
        
        2022年7月16日 2:00 AM
        
        espresso8様、アドバイスに加えてコードのご提供までしてくださり、誠にありがとうございます。ご助言の通り試行してみたのですが、
        
        実行時エラー’450′:
        引数の数が一致していません。または不正なプロパティを指定しています。
        
        とのメッセージが表示されて不発に終わってしまいました。
        これをうけて当方でも以下のように対処を施しました。
        
        ・「関数名」と「Sub定義のプロシージャ名」が一致してしまうことで、プロシージャの呼び出しが優先されてしまい、それが結果として引数の数を誤認することでもこのエラーを吐くという情報を得ました。なので引数が使われているSubプロシージャの名前重複なども検索して調べてみましたが、こちらが調べた限りでは見つからず…
        
        ・Hyperlinks.Addの構文を、以下のように修正しました。
        .Hyperlinks.Add Anchor:=Range(“C” & CStr(lcnt)), _
        Address:=sFilePath & sTmpPath, _
        SubAddress:=sTmpSheetName & “!” & convertRange(rFoundCell.Column) & rFoundCell.Row
        この状態で実行してみると、なぜかGrepシートではなく、「検索”先”」のシートのC列8行目からハイパーリンクが張り付けられていくという処理結果になりました。
        
        上記の通り2つの方法を試みてみましたが未だうまくいかず…(;_;)
        何度もお手数をおかけして大変申し訳ありません。こちらといたしましても是非、Espresso8様のマクロを理想形のものに組みあげたい所存です。ご助力願えないでしょうか。
      2. espresso8 より:
        
        2022年7月16日 9:09 PM
        
        すみません、必要な半角スペースを入れていませんでした。
        「実行時エラー’450′:
        引数の数が一致していません。または不正なプロパティを指定しています。」
        のエラーの原因は、
        .Hyperlinks.Add
        と
        .Range(“C” & CStr(lcnt)),
        の間に半角スペースが無かったためです。
        
        .Hyperlinks.Add .Range(“C” & CStr(lcnt)), sFilePath & sTmpPath, sTmpSheetName & “!” & convertRange(rFoundCell.Column) & rFoundCell.Row
        これでエラーが解消されるはずなのですが、どうでしょうか。
KAI より:

2022年7月16日 9:40 PM

espresso8様、
度重なるご協力の末、理想通りの動きをするマクロを構築できました。

検索先のセルに、PDFなどのファイルのリンク付けをしていたので
おかげさまでその閲覧がスムーズにできるようになりました。

お付き合いくださり大変感謝申し上げます。
本当にありがとうございました！

返信
Issac より:

2022年8月10日 6:48 PM

ありがとうございます。
コード色々使わせていただいています。

二点お伺いしたいです。
フャイル開くときなんらかの理由で開かけないまたは開く途中で止まる際にはどう対応したほうがいいでしょうか。
パスワード付きフャイルの場合とか、保護モードのフャイルの場合です。

もう一点、たまに読み込み専用モードで開いても、閉じる際に保存しますかと出るフャイルがいて、どう対応した方がいいでしょうか

お願いします

返信
1. espresso8 より:
  
  2022年8月11日 4:45 PM
  
  Issacさん、コメントありがとうございます！
  ソースコードがお役に立てているようで嬉しいです！
  
  コメント欄で上手く説明できそうになかったので、ソースを修正しました。
  ただ、パスワード付ファイルがある場合しか動作確認できていません。
  問題などあれば、教えていただけると助かります。
  
  ・On Error Resume Next
  　これで、エラーがあった場合も、有効範囲内（On Error GoTo 0まで）では処理が続行されます。
  
  ・パスワード付のファイルの場合は、
  Password:=””
  のオプションによって、パスワード違いで開けない場合エラー扱いになります。
  パスワードが設定されていないファイルは、このオプションが無視されます。
  Workbooks.Open の直後に
  If Err.Number = 0 Then
  で条件分岐を入れたので、エラーのファイルの場合は無視されます。
  
  ・閉じる処理のオプションに Application.DisplayAlerts = False
  これで閉じる際の確認メッセージが出ないハズです。
  
  返信
  1. Issac より:
    
    2022年8月24日 3:34 PM
    
    ご返信ありがとうございます！
    最新版ソース取り込んだら正常に動作しました！
    
    返信
    1. espresso8 より:
      
      2022年8月24日 10:28 PM
      
      上手くいったようで良かったです。
      開く際に問題があるファイルがあっても、処理を続けられるよう改善できて、
      私としても嬉しいです！
      
      返信
おさかな より:

2022年8月12日 5:36 PM

こんにちは。
コード、大変ありがたく使用させていただいております。

1点お伺いしたいのですが、
検索したエクセルファイルを閉じるにはどうしたら良いのでしょうか。
どこにcloseを挿入すれば良いのかが分からず…

検索結果が多いのでブックの数がえらいことになってしまいます。

大変恐縮ですがご教示いただけますでしょうか。
よろしくお願いします。

返信
1. espresso8 より:
  
  2022年8月12日 6:42 PM
  
  おさかなさん、コメントありがとうございます！
  
  ソースの中でエクセルファイルを閉じる処理は、
  Workbooks(sTmpPath).Close Application.DisplayAlerts = False
  と書いてある行です。
  Workbooksに、ファイル名となる引数 sTmpPath を渡して、
  開いているGrep対象のファイル（ファイル名はsTmpPath）を閉じています。
  Application.～のオプションは、閉じる際に確認メッセージを表示させないためのものです。
  
  検索対象のエクセルファイルを開くのは１つまで、同時に２つ以上開かない挙動を想定しています。
  
  エクセルファイルを上手く閉じれていないということですので、
  Workbooks(sTmpPath).Close Application.DisplayAlerts = False
  の行にブレイクポイントを入れてから処理を実行してみて、
  sTmpPathに開いているエクセルのファイル名を上手く渡せているかどうか
  変数をウォッチ式に追加して確認してみてはいかがでしょうか。
  また、何かエラーが出ていないかどうか、上記の行を通過した直後に
  Err.Number　の値を見てみると解決につながるかもしれません。
  
  返信
  1. おさかな より:
    
    2022年8月15日 2:27 PM
    
    返信ありがとうございます。
    
    どうやら全てのファイルが閉じれないのではなく、特定のファイルだけ残っているようです。
    原因特定が難しかったので、
    最後にThisWorkbook以外のブックを閉じるという動きを入れて、力技で閉じることに成功しました笑
    
    ご教示いただきありがとうございます！
    
    返信
    1. espresso8 より:
      
      2022年8月24日 10:26 PM
      
      そのやり方は思い浮かばなかったです。
      無事解決できたようで良かったです。
      こちらこそ、勉強になりました。
      ありがとうございます！
      
      返信
さくら より:

2022年9月15日 4:27 PM

はじめまして！
ファイル数が14000件ある中の特定の文字列を検索するのに使用しようと思いました。
しかしながら拡張子xlsmのファイルにて
「実行時エラー 9
インデックスが有効範囲にありません」
が発生し止まってしまいます。
こちらはマクロが入っているファイルは検索できない仕様となりますか。

よろしくお願いいたします

返信
1. espresso8 より:
  
  2022年9月16日 7:10 PM
  
  さくらさん、コメントありがとうございます！
  拡張子が.xlsm のファイルが含まれる状態で実行してみましたが、
  .xlsm のファイル内に含まれるキーワードの部分も処理結果に表示できました。
  単純に、マクロの入っているファイルと言うだけでは再現できませんでした。
  
  Excelファイルを１つずつ開いて閉じてと繰り返しているので、
  ファイルを開いた際に実行されるような処理の入っているものがあれば、
  影響はありそうです。
  
  また、ファイル数が14000件とのことですが、数字の変数を定義している箇所をすべて
  Long型にしているので、こちらは原因ではないかもしれません。
  
  エラーメッセージの出るファイルだけ別の箇所に複製して、
  Grepする処理をステップ実行で動かしてみると、
  原因を特定できそうです。
  
  返信
さくら より:

2022年9月19日 11:23 AM

切り分けて確認してみました。
どうやら、ファイルそのものが良くないらしく
普通に開いて、「実行時エラー 9」のダイアログが発生しました。
どうやら指定するExcelブックが無いため発生しているようです。
こちらを強制的に「終了（E）」にさせて、処理を続けることは可能でしょうか。
お手数ではございますがご教授頂けますと幸いです。

返信
1. espresso8 より:
  
  2022年9月25日 10:51 PM
  
  さくらさん、遅くなってすみません。
  
  On Error Resume Next
  があるので、エラーをスキップできるはずなんですが。
  他のブック内のエラーだと効かないみたいですね。。。
  
  少し探してみましたが、参考になりそうな情報が次のYahoo知恵袋くらいでした。
  https://detail.chiebukuro.yahoo.co.jp/qa/question_detail/q10222224470
  
  返信
sami1 より:

2024年5月14日 9:15 AM

はじめまして、VBA初心者です。こちらのサイトを偶然見つけ記載の手順通りに作成してみたのですが、動かしてみると、Excel１シートに検索対象が複数ある場合も１つしか検索結果に出力されないという結果になってしまいました。
初心者ゆえ、特に個人でソースの追加や削除などは行っておらず原因が分からず、
もし思い当たる点など何かございましたらご教示いただけると幸いです。

返信
1. espresso8 より:
  
  2024年5月15日 12:25 AM
  
  初めまして、コメントありがとうございます！
  申し訳ないですが、バグのようです。
  grepExcelSheet　のループ処理の条件が、1シート内の最初に見つかったセル内の文字列と異なる間ループするようにしていました。
  2番目以降に見つかったセルでも、最初に見つかったものと全く同じ文字列のセルだった場合はループを抜けてしまいます。
  
  修正する箇所ですが、ループを継続する条件の
  Loop While rTmpFoundCell ＜＞ rFoundFirstCell
  このままだとセル内の文字列で比較してしまうので、
  Loop While rTmpFoundCell.Address ＜＞ rFoundFirstCell.Address
  のようにアドレスで比較すれば、おそらく大丈夫だと思います。
  
  ※比較する演算子の＜＞を半角で書くと、なぜかコメント欄から消えてしまうので、あえて全角で書いています。
  半角に読み替えていただければと思います。
  
  返信
  1. sami1 より:
    
    2024年5月26日 7:17 PM
    
    返信が遅くなってしまいすみません。
    そしてご丁寧なご返信誠にありがとうございます。
    回答いただいた通りに修正したら期待通りの動きになりました。
    大変助かりました、ありがとうございました！！
    
    返信