| 
    
     |  | 回答及び例示までありがとうございます。 最初の2つの回答を頂き作成しておりました。
 FIMDNEXTが動かないところで四苦八苦しておりましたが;。
 私の作成した例は下記ですが、UC3さんとほぼ同じロジックかと思います。
 ありがとうございました。
 
 Function aaa()
 Dim SercfArea As Range
 Dim FoundCell As Range, FirstCell As Range, Target As Range
 Dim strStartcell As String, strEndcell As String
 '処理範囲の設定
 strStartcell = "A1"
 strEndcell = "D30"
 Set SercfArea = Range(strStartcell, strEndcell)
 
 '検索条件の初期化
 Application.FindFormat.Clear
 '処理実行
 Application.FindFormat.NumberFormatLocal = "G/標準"
 Set FoundCell = SercfArea.Find(What:="", LookIn:=xlFormulas, LookAt:=xlWhole _
 , SearchOrder:=xlByRows, SearchDirection:=xlNext, MatchCase:=False _
 , MatchByte:=False, SearchFormat:=True)
 
 If FoundCell Is Nothing Then
 Else
 Set FirstCell = FoundCell
 Set Target = FoundCell
 Do
 Set FoundCell = SercfArea.Find(What:="", After:=FoundCell, LookIn:=xlFormulas _
 , LookAt:=xlWhole, SearchOrder:=xlByRows, SearchDirection:=xlNext, MatchCase:=False _
 , MatchByte:=False, SearchFormat:=True)
 
 If FoundCell.Address = FirstCell.Address Then
 Exit Do
 Else
 Set Target = Union(Target, FoundCell)
 Debug.Print FoundCell.Address
 
 End If
 Loop
 End If
 
 Target.Interior.ColorIndex = 5 'BLUE
 End Function
 
 |  |