セルの文字を検索してファイル名とセルのアドレスを取得しハイパーリンクで開く

Find VBA Excel VBA Find

複数のフォルダーの中にあるファイルからセルに入力されている文字を検索してファイル名とセルの文字とセルのアドレスを取得しハイパーリンクで開く方法を紹介します。

検索して文字が見つかったファイル名はエクセルシートのセルA2の下に、検索して文字が見つかったセルの値はセルB2の下に、検索して文字が見つかったセルのアドレス(番地)はセルC2の下に表示されます、表示されたファイル名をクリックするとファイルを開くことができます。

VBEを起動し標準モジュールを作成して下のコードをModule1に貼り付けます。

Sub セルに入力されている文字を検索してファイル名とセルのアドレスを表示しハイパーリンクで開く()

Dim file_name As String
Dim folder_name(12) As String '12個の配列要素の宣言をします。

folder_name(0) = ThisWorkbook.Path & "\フォルダ1\"
folder_name(1) = ThisWorkbook.Path & "\フォルダ2\"
folder_name(2) = ThisWorkbook.Path & "\フォルダ3\"
folder_name(3) = ThisWorkbook.Path & "\フォルダ4\"
folder_name(4) = ThisWorkbook.Path & "\フォルダ5\"
folder_name(5) = ThisWorkbook.Path & "\フォルダ6\"
folder_name(6) = ThisWorkbook.Path & "\フォルダ7\"
folder_name(7) = ThisWorkbook.Path & "\フォルダ8\"
folder_name(8) = ThisWorkbook.Path & "\フォルダ9\"
folder_name(9) = ThisWorkbook.Path & "\フォルダ10\"
folder_name(10) = ThisWorkbook.Path & "\フォルダ11\"
folder_name(11) = ThisWorkbook.Path & "\フォルダ12\"

Dim i As Integer
Dim Q As Integer

i = 0 '変数iを0にしてフォルダ名(folder_name)を初期値にします。

For Q = 1 To 12 'For..Nextステートメントで12回繰り返します。

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

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

Workbooks.Open folder_name(i) & 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(i) & 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

i = i + 1 'iの値を1つずつ増やしてフォルダ名(folder_name)を0~11まで変えていきます。

Next Q

End Sub

ThisWorkbook.Pathでファイルパスを取得しているので文字を検索するフォルダはマクロを実行するファイルと同じフォルダに入れて下さい。

【マクロ(プログラム)の実行方法】マクロを実行するファイルのSheet1を表示してセルのA1に検索したい文字を入力します、そして「開発タブ」→「マクロ」→ 実行するマクロ名を選択 →「実行」ボタンをクリックすると検索が開始します。

Findメソッドで検索後、FindNextメソッドで次のセルの文字を検索してDo…Loop Untilステートメントの条件式で最初に文字が見つかったセルのアドレスに戻るまで繰り返し検索するようにしています。

文字を検索する範囲はRange(“A2:R30”)で部分一致で検索しています、必要に応じて範囲指定を変更したり完全一致の検索にするなどためしてみてください。

コメント