【VBA】検索結果一覧

 #basic 
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

この記事が気に入ったらサポートをしてみませんか?