一つのフォルダーの中にあるエクセルファイルからセルの文字を検索してファイル名とセルの文字とセルのアドレスを表示しハイパーリンクで開く方法を紹介します。
プログラムの実行手順は下の通りです。
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
コメント