| |
回答及び例示までありがとうございます。
最初の２つの回答を頂き作成しておりました。
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
|
|
ヤムチャ
- 11/10/11(火) 20:30 -
