Sub SearchWordInExcelFiles()
Dim FolderPath As String
Dim FileName As String
Dim ExcelFile As Workbook
Dim ws As Worksheet
Dim cell As Range
Dim searchWord As String
Dim found As Boolean
' 検索するフォルダを選択
With Application.FileDialog(msoFileDialogFolderPicker)
.Title = "フォルダを選択してください"
If .Show = -1 Then
FolderPath = .SelectedItems(1)
Else
MsgBox "フォルダが選択されませんでした。"
Exit Sub
End If
End With
' 検索するワード
searchWord = InputBox("検索するワードを入力してください:")
' フォルダ内のすべてのExcelファイルをループ
FileName = Dir(FolderPath & "\*.xls*")
Do While FileName <> ""
Set ExcelFile = Workbooks.Open(FolderPath & "\" & FileName)
found = False
' 各シートをループ
For Each ws In ExcelFile.Sheets
' 各セルをループして検索
For Each cell In ws.UsedRange
' セルがエラーでないか、空でないかを確認
If Not IsError(cell.Value) And Not IsEmpty(cell.Value) Then
' セルの値が文字列か確認
If VarType(cell.Value) = vbString Then
If InStr(1, cell.Value, searchWord, vbTextCompare) > 0 Then
found = True
MsgBox "見つかりました: " & searchWord & " in " & FileName & " シート: " & ws.Name & " セル: " & cell.Address
End If
End If
End If
Next cell
Next ws
' ファイルを閉じる
ExcelFile.Close SaveChanges:=False
' 次のファイル
FileName = Dir
Loop
If Not found Then
MsgBox "ワード '" & searchWord & "' は見つかりませんでした。"
End If
End Sub