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