Function GetCellsAddress( _
ByRef CellsList As Variant _
, ByRef varObject As Variant _
, ByRef What As Variant _
, Optional ByRef After As Variant _
, Optional ByRef LookIn As Variant _
, Optional ByRef LookAt As Variant _
, Optional ByRef SearchOrder As Variant _
, Optional ByRef SearchDirection As Variant = xlNext _
, Optional ByRef MatchCase As Variant _
, Optional ByRef MatchByte As Variant _
, Optional ByRef SearchFormat As Variant _
) As Boolean
On Error GoTo Catch
Dim c As Range
Dim firstAddress As String
ReDim CellsList(0) As Variant
GetCellsAddress = False
With varObject
Set c = .Find( _
What:=What _
, After:=After _
, LookIn:=LookIn _
, LookAt:=LookAt _
, SearchOrder:=SearchOrder _
, SearchDirection:=SearchDirection _
, MatchCase:=MatchCase _
, MatchByte:=MatchByte _
, SearchFormat:=SearchFormat _
)
If Not c Is Nothing Then
firstAddress = c.Address '初回検索結果
CellsList(0) = c.Address '配列追加
Do
Set c = .FindNext(c)
If c Is Nothing Or c.Address = firstAddress Then
Exit Do
Else
'配列追加
If Not IsEmpty(CellsList(UBound(CellsList))) Then
ReDim Preserve CellsList(UBound(CellsList) + 1)
End If
CellsList(UBound(CellsList)) = c.Address
End If
Loop Until c.Address = firstAddress
End If
End With
GetCellsAddress = True
GoTo Finally
Catch:
GetCellsAddress = False
Debug.Print "■エラー【GetCellsAddress】" & vbCrLf & Err.Number & vbTab & Err.Description
MsgBox "エラーが発生しました", , "エラー"
Finally:
End Function