複数のフォルダーの中にあるファイルを検索してファイル名とセルの値を表示します。
検索したファイル名はエクセルシートのA列のセルに表示し検索したセルの値はB列のセルに表示されます、表示されたファイル名をクリックするとファイルを開くことができます。
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 'ファイルを開きます。
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 = Workbooks(file_name).Worksheets("Sheet1").Range("A1").Value
End With
Workbooks(file_name).Close savechanges:=False 'ファイルを閉じます。
file_name = Dir()
Loop
i = i + 1 'iの値を1つずつ増やしてフォルダ名(folder_name)を0~11まで変えていきます。
Next Q
End Sub
下から8行目のWorksheets(“Sheet1”).Range(“A1”).ValueのRange(“○○”)を変えれば別のセルの値を取得することができます。
ThisWorkbook.Pathでファイルパスを取得しているのでファイル検索するフォルダはマクロを実行するブックと同じフォルダに入れて下さい。
ファイル名とファイル内の特定のセルの値を知りたいとき便利だと思いますのでお試し下さい。
コメント