ここから本文です

1つのフォルダ内にある複数のエクセルファイルで検索をかけるマクロを組みたいで...

aou********さん

2019/6/1423:04:56

1つのフォルダ内にある複数のエクセルファイルで検索をかけるマクロを組みたいです。

条件としては、

①検索をかけるのはいずれのエクセルファイルもH列で検索をかける。
②検索結果結果を1つのシートにまとめて表示。
③検索結果で表示するのは検索をかけてヒットしたセルのあるファイル名、ヒットしたセルのある行のA列、B列、F列、H列、I列の文字列を左詰めで表示
④可能であれば、検索結果で上記を表示した1番右側のセルに検索でヒットしたセルへのリンクを表示。

お手数ですがよろしくお願い致します。

閲覧数:
49
回答数:
1
お礼:
100枚

違反報告

ベストアンサーに選ばれた回答

kky********さん

2019/6/1508:47:56

フォルダは選択、検索文字は入力、検索するシートは最初のシートとしました。
結果はこのマクロを入れるブックの最初のシートとしています。
データ数がわからないので、処理速度は考慮していません。

Sub Sample()
Dim fpath As String
Dim kword As String
Dim fname As String
Dim sh As Worksheet
Dim wb As Workbook
Dim i As Long, j As Long
With Application.FileDialog(msoFileDialogFolderPicker)
If .Show = False Then Exit Sub
fpath = .SelectedItems(1) & "\"
End With
kword = InputBox("検索文字入力")
If kword = "" Then Exit Sub
Application.ScreenUpdating = False
Set sh = ThisWorkbook.Worksheets(1)
j = 1
fname = Dir(fpath & "*.xlsx", vbNormal)
Do Until fname = ""
Set wb = Workbooks.Open(fpath & fname)
With wb.Worksheets(1)
For i = 1 To Cells(Rows.Count, "H").End(xlUp).Row
If .Range("H" & i) = kword Then
j = j + 1
sh.Range("A" & j) = Range("A" & i)
sh.Range("B" & j) = Range("B" & i)
sh.Range("C" & j) = Range("F" & i)
sh.Range("D" & j) = Range("H" & i)
sh.Range("E" & j) = Range("I" & i)
sh.Hyperlinks.Add sh.Range("F" & j), Address:=fpath & fname, _
SubAddress:=.Range("H" & i).Address, TextToDisplay:=fpath & fname & " " & .Range("H" & i).Address
End If
Next
End With
wb.Close
fname = Dir()
Loop
Application.ScreenUpdating = True
MsgBox "処理終了"
End Sub

  • kky********さん

    2019/6/2009:44:19

    そのままになっていますが、意図と違いましたか。
    回答期限の明日は時間が取れないので、不具合があれば今日連絡をお願いします。

返信を取り消しますが
よろしいですか?

  • 取り消す
  • キャンセル

質問した人からのコメント

2019/6/20 16:46:01

たすかりました。ありがとうございました。

みんなで作る知恵袋 悩みや疑問、なんでも気軽にきいちゃおう!

Q&Aをキーワードで検索:

Yahoo! JAPANは、回答に記載された内容の信ぴょう性、正確性を保証しておりません。
お客様自身の責任と判断で、ご利用ください。
本文はここまでです このページの先頭へ

「追加する」ボタンを押してください。

閉じる

※知恵コレクションに追加された質問は選択されたID/ニックネームのMy知恵袋で確認できます。

不適切な投稿でないことを報告しました。

閉じる