FindCellWithFormula

' FindCellWithFormula
' -----------------
' Macro Name: FindCellWithFormula
' Description: 数式が含まれるセルを検索する
' Parameters: なし
' Returns: なし
' Usage: 実行すると数式を含むセルが一覧表示され、該当セルにジャンプできる
' -----------------

Sub FindCellWithFormula()
    Dim ws As Worksheet
    Dim foundCells As Collection
    Dim cell As Range
    Dim formulaCells As String
    Dim outputWs As Worksheet
    Dim outputRow As Long
    Dim i As Long

    On Error GoTo ErrorHandler

    Set ws = ActiveSheet
    Set foundCells = New Collection

    For Each cell In ws.UsedRange
        If cell.HasFormula Then
            foundCells.Add cell
        End If
    Next cell

    If foundCells.Count = 0 Then
        MsgBox "数式が含まれるセルは見つかりませんでした。", vbInformation
        Exit Sub
    End If

    Set outputWs = Worksheets.Add(After:=Worksheets(Worksheets.Count))
    outputWs.Name = "数式検索_" & Format(Now, "hhnnss")

    outputWs.Cells(1, 1).Value = "数式セル一覧"
    outputWs.Cells(1, 1).Font.Bold = True
    outputWs.Cells(1, 1).Font.Size = 14

    outputWs.Cells(2, 1).Value = "シート: " & ws.Name
    outputWs.Cells(3, 1).Value = "検索結果: " & foundCells.Count & " 件"

    outputWs.Cells(5, 1).Value = "行"
    outputWs.Cells(5, 2).Value = "列"
    outputWs.Cells(5, 3).Value = "アドレス"
    outputWs.Cells(5, 4).Value = "数式"
    outputWs.Cells(5, 1).Font.Bold = True
    outputWs.Cells(5, 2).Font.Bold = True
    outputWs.Cells(5, 3).Font.Bold = True
    outputWs.Cells(5, 4).Font.Bold = True
    outputWs.Range(outputWs.Cells(5, 1), outputWs.Cells(5, 4)).Interior.Color = RGB(200, 200, 200)

    outputRow = 6
    For i = 1 To foundCells.Count
        Set cell = foundCells(i)
        outputWs.Cells(outputRow, 1).Value = cell.Row
        outputWs.Cells(outputRow, 2).Value = cell.Column
        outputWs.Cells(outputRow, 3).Value = cell.Address
        outputWs.Cells(outputRow, 4).Value = cell.Formula
        outputRow = outputRow + 1
    Next i

    outputWs.Columns("A:D").AutoFit
    outputWs.Select

    MsgBox foundCells.Count & " 件の数式セルが見つかりました。", vbInformation
    Exit Sub

ErrorHandler:
    MsgBox "エラーが発生しました: " & Err.Description, vbCritical
End Sub