ファイル内のセルの文字を検索してハイパーリンクで開く

Excel VBA Find

一つのフォルダーの中にあるエクセルファイルからセルの文字を検索してファイル名とセルの文字とセルのアドレスを表示しハイパーリンクで開く方法を紹介します。

前回投稿した記事の「セルの文字を検索してファイル名とセルのアドレスを取得しハイパーリンクで開く」の補足説明として参考にして下さい。下のプログラムは分かりやすいように一つのフォルダから文字を検索するようにしています。

プログラムの実行手順は下の通りです。

1.検索するフォルダを指定します。
2.フォルダ内のエクセルファイルを順番に開きます。
3.開いたファイル内のセルの文字を検索します。(FindNextで全てのセルの文字を検索しています)
4.検索して文字のあったファイル名がシートに表示されます。
5.ファイル名をクリックするとファイルを開く事ができます。

Sub ファイル内のセルの文字を検索してハイパーリンクで開く()

Dim folder_name As String
Dim file_name As String

folder_name = ThisWorkbook.Path & "\フォルダ\" '検索するフォルダを指定します。

file_name = Dir(folder_name & "*.xlsx") 'Dir関数で検索します。

Do While file_name <> "" 'フォルダ内にエクセルのファイルが見つかる間は処理を行います。

Workbooks.Open folder_name & file_name 'ファイルを開きます。

Dim search_rang As Range
Dim search_text As String
Dim default_value As String

search_text = ThisWorkbook.Worksheets(1).Range("A1").Value 'マクロを実行しているファイルのセルA1の値で検索する。

Set search_rang = Worksheets(1).Range("A2:R30").Find(What:=search_text, LookAt:=xlPart) '部分一致で検索します。

If Not search_rang Is Nothing Then '検索結果が見つかった場合の処理。

default_value = search_rang.Address '最初に見つかったセルのアドレスを変数(default_value)記憶しておきます。

Do

With ThisWorkbook.Worksheets("Sheet1").Cells(Rows.Count, 1).End(xlUp) 'セルの最終行取得。

.Hyperlinks.Add Anchor:=.Offset(1, 0), Address:=folder_name & file_name, TextToDisplay:=file_name
.Offset(1, 1).Value = search_rang.Value 'セルの値を取得してB列に表示する。
.Offset(1, 2).Value = search_rang.Address 'セルのアドレス(番地)を取得してC列に表示する。

End With

Set search_rang = Worksheets(1).Range("A2:R30").FindNext(search_rang) '次のセルを検索します。

Loop Until search_rang.Address = default_value '最初に文字が見つかったセルのアドレスに戻るまで繰り返します。

End If

Workbooks(file_name).Close savechanges:=False 'ファイルを閉じます。

file_name = Dir()

Loop

End Sub

コメント