20210820_01

‘現在開いているブックの全シートを対象に文字列検索をおこなう。
‘検索結果はシート「検索結果+検索文字列」に出力
‘流用元：https://oshiete.goo.ne.jp/qa/3555630.html
Sub ブック全体のセル内文字列検索()

Dim kwd
kwd = Application.InputBox("検索文字列を入力してください")
If TypeName(kwd) <> "Boolean" Then

    '検索結果のシートを探す
    Dim hasAdSht As Boolean
    For Each ws In Worksheets
        If ws.Name = "検索結果" & kwd Then
            hasAdSht = True
            Exit For
        End If
    Next ws
    Dim adSht As Worksheet
    If hasAdSht Then
        '検索結果のシートが存在したら、全セルクリア
        Set adSht = ws
        adSht.Cells.ClearContents
    Else
        '存在しなれば新規追加
        Set adSht = Worksheets.Add
        adSht.Name = "検索結果" & "【" & kwd & "】"
        'ヘッダー行を入力
        ActiveSheet.Cells(1, 1).Value = "シート名"
        ActiveSheet.Cells(1, 2).Value = "セル番地"
        ActiveSheet.Cells(1, 3).Value = "セル内文字列"
    End If

    Dim actSht As Worksheet
    Set actSht = ActiveSheet

    Dim cnt As Long
    cnt = 1

    For Each ws In Worksheets
        If ws.Name = adSht.Name Then
            '検索結果のシートはスキップ
            GoTo Continue
        End If
        With ws.Cells
            'シートを検索
            Dim r As Range
            Set r = .Find(kwd, LookIn:=xlValues, lookat:=xlPart) '文字列検索
            'ヒットしたら
            If Not r Is Nothing Then
                '1件目のヒット情報出力
                cnt = cnt + 1
                adSht.Cells(cnt, 1).Value = ws.Name
                adSht.Cells(cnt, 2).Value = r.Address
                adSht.Cells(cnt, 3).Value = r.Value

                Dim adr As String
                adr = r.Address

                Do
                    'シートを検索
                    Set r = .FindNext(r)
                    If r.Address = adr Then
                        '次のヒットが無ければ終了
                        Exit Do
                    Else
                        cnt = cnt + 1
                        adSht.Cells(cnt, 1).Value = ws.Name
                        adSht.Cells(cnt, 2).Value = r.Address
                        adSht.Cells(cnt, 3).Value = r.Value
                    End If
                Loop
            End If
        End With

Continue:
Next

End If
actSht.Activate

MsgBox "ブック内のセル内文字検索が終了しました。"

End Sub

‘現在開いているブックの全シートを対象に文字列検索をおこなう。
‘検索結果はシート「検索結果+検索文字列」に出力
‘流用元：https://oshiete.goo.ne.jp/qa/3555630.html
Sub ブック全体のセル内数式検索()

Dim kwd
kwd = Application.InputBox("検索文字列を入力してください")
If TypeName(kwd) <> "Boolean" Then

    '検索結果のシートを探す
    Dim hasAdSht As Boolean
    For Each ws In Worksheets
        If ws.Name = "検索結果" & kwd Then
            hasAdSht = True
            Exit For
        End If
    Next ws
    Dim adSht As Worksheet
    If hasAdSht Then
        '検索結果のシートが存在したら、全セルクリア
        Set adSht = ws
        adSht.Cells.ClearContents
    Else
        '存在しなれば新規追加
        Set adSht = Worksheets.Add
        adSht.Name = "検索結果" & "【" & kwd & "】"
        'ヘッダー行を入力
        ActiveSheet.Cells(1, 1).Value = "シート名"
        ActiveSheet.Cells(1, 2).Value = "セル番地"
        ActiveSheet.Cells(1, 3).Value = "セル内文字列"
    End If

    Dim actSht As Worksheet
    Set actSht = ActiveSheet

    Dim cnt As Long
    cnt = 1

    For Each ws In Worksheets
        If ws.Name = adSht.Name Then
            '検索結果のシートはスキップ
            GoTo Continue
        End If
        With ws.Cells
            'シートを検索
            Dim r As Range

‘ Set r = .Find(kwd, LookIn:=xlValues, lookat:=xlPart) ‘文字列検索
Set r = .Find(kwd, LookIn:=xlFormulas, lookat:=xlPart) ‘数式検索
‘ヒットしたら
If Not r Is Nothing Then
‘1件目のヒット情報出力
cnt = cnt + 1
adSht.Cells(cnt, 1).Value = ws.Name
adSht.Cells(cnt, 2).Value = r.Address
adSht.Cells(cnt, 3).Value = r.Formula

                Dim adr As String
                adr = r.Address

                Do
                    'シートを検索
                    Set r = .FindNext(r)
                    If r.Address = adr Then
                        '次のヒットが無ければ終了
                        Exit Do
                    Else
                        cnt = cnt + 1
                        adSht.Cells(cnt, 1).Value = ws.Name
                        adSht.Cells(cnt, 2).Value = r.Address
                        adSht.Cells(cnt, 3).Value = r.Formula
                    End If
                Loop
            End If
        End With

Continue:
Next

End If
actSht.Activate

MsgBox "ブック内の数式内の文字検索が終了しました。" & vbCrLf & "数式ではない文字列のセルもヒットしています。" & vbCrLf & "数式の場合は文字列に数式が出力されています。"

End Sub