検索したセルすべてに対して処理する

' 検索したセルすべてに対して処理したい
Private Sub AllSerchCell(ByVal serchStr As String)

    Dim rng As Range
    Dim firstCell As Range
    Dim rngUnion As Range
    
    '検索条件を指定して検索開始
    Set rng = Cells.Find(What:=serchStr)
    If rng Is Nothing Then
        MsgBox "「" & serchStr & "」が見つかりません"
        Exit Sub
    Else
        Set firstCell = rng
        Set rngUnion = rng
    End If
    '「次のセル」の検索を続行
    Do
        ' 次のセルを検索
        Set rng = Cells.FindNext(rng)
        
        If rng.Address = firstCell.Address Then
            ' 最初に検索したセルと同じセルを検索したら終了
            Exit Do
        Else
            ' それ以外は、セルを統合
            Set rngUnion = Union(rngUnion, rng)
        End If
    Loop
    
    'rngUnionに格納しておいた全検索結果をまとめたセルを操作
    rngUnion.Interior.ColorIndex = 6    ' 網掛けを黄色に
    MsgBox "「" & serchStr & "」が　" & rngUnion.Count & "件見つかりました"

End Sub

Private Sub test()
    Call AllSerchCell("ｆｄさ５")
End Sub