結局、お茶を濁して終わらせた話（失敗談）

今日は結局、お茶を濁して終わらせたお話。

こちらのブログでも紹介した、ユーザー定義関数「FindAll」。
少し前に、これが誤動作することが分かった。

もともと、指定したキーワードがシート状に複数ある場合、そのキーワードを含むセル全てをRangeで返す仕様となっている。

Function FindAll(target_range As Range, _
                 faWhat As String, _
        Optional faLookIn As Excel.XlFindLookIn = xlValues, _
        Optional faLookAt As Excel.XlLookAt = xlPart, _
        Optional faMatchCase As Boolean = False, _
        Optional faMatchByte As Boolean = False) As Range

    Dim FindCell As Range
    Dim FoundCell As Range
    Dim TempRange As Range
    
    '対象を全て選択するため、検索の開始位置や向きなどは指定していない。
    Set FindCell = target_range.Find(faWhat, _
                                     , _
                                     faLookIn, _
                                     faLookAt, _
                                     , _
                                     , _
                                     faMatchCase, _
                                     faMatchByte)
    
        If FindCell Is Nothing Then
            Exit Function
        Else
            Set FoundCell = FindCell
            Set TempRange = FindCell
        End If
        
        Do
            Set FindCell = target_range.Find(faWhat, FindCell)
            If FindCell.Address = FoundCell.Address Then
                Exit Do
            Else
                Set TempRange = Union(TempRange, FindCell)
            End If
        Loop

    Set FindAll = TempRange
End Function

ところが先日、これを用いたツールで
「処理が終わらない」
という報告があった。確認したところ、最初に見つけたセルがもう一度検索対象としてヒットした（つまり全部探し終わって、ぐるっと一周した）あとも、検索が終わっていなかった。なぜだ。

理由が分からないまま試行錯誤するうち、だったらUnionメソッドではなく、アドレスを辞書に格納する方法ではどうかと考えた。それが、こちらだ。

Function FindAll(target_range As Range, _
                 faWhat As String, _
        Optional faLookIn As Excel.XlFindLookIn = xlValues, _
        Optional faLookAt As Excel.XlLookAt = xlPart, _
        Optional faMatchCase As Boolean = False, _
        Optional faMatchByte As Boolean = False) As Range

    Dim FindCell As Range
    Dim Dict As Object
    Set Dict = CreateObject("Scripting.Dictionary")
    
    '対象を全て選択するため、検索の開始位置や向きなどは指定していない。
    Set FindCell = target_range.Find(faWhat, _
                                     , _
                                     faLookIn, _
                                     faLookAt, _
                                     , _
                                     , _
                                     faMatchCase, _
                                     faMatchByte)
    
        If FindCell Is Nothing Then
            Exit Function
        Else
            Dict(FindCell.Address) = 1
        End If
        
        Do
            Set FindCell = target_range.Find(faWhat, FindCell)
            If Dict.Exists(FindCell.Address) Then
                Exit Do
            Else
                Dict(FindCell.Address) = 1
            End If
        Loop

    Set FindAll = Range(Join(Dict.keys, ","))
End Function

辞書はkeyの重複を認めない。従って、登録済みのキーが登場した時点で全て探しきったものとして、そのアドレスで直に範囲を指定すればよいと考えたわけだ。
しかし、これは見事に失敗した。理由はこちら。
infoment.hatenablog.com

やむを得ない、こればかりに時間を掛けていられない。結局、先の二つを組み合わせ、辞書は「無限ループから抜けるための保険」としてのみ使用することにした。

Function FindAll(target_range As Range, _
                 faWhat As String, _
        Optional faLookIn As Excel.XlFindLookIn = xlValues, _
        Optional faLookAt As Excel.XlLookAt = xlPart, _
        Optional faMatchCase As Boolean = False, _
        Optional faMatchByte As Boolean = False) As Range

    Dim FindCell As Range
    Dim FoundCell As Range
    Dim TempRange As Range
    
    Dim Dict As Object
    Set Dict = CreateObject("Scripting.Dictionary")
    
    '対象を全て選択するため、検索の開始位置や向きなどは指定していない。
    Set FindCell = target_range.Find(faWhat, _
                                     , _
                                     faLookIn, _
                                     faLookAt, _
                                     , _
                                     , _
                                     faMatchCase, _
                                     faMatchByte)
    
        If FindCell Is Nothing Then
            Exit Function
        Else
            Set FoundCell = FindCell
            Set TempRange = FindCell
        End If
        
        Do
            Set FindCell = target_range.Find(faWhat, FindCell)
            If FindCell.Address = FoundCell.Address Then
                Exit Do
            Else
                Set TempRange = Union(TempRange, FindCell)
            End If
            
            ' 無限ループ防止用の保険。
            If Dict.Exists(FindCell.Address) Then
                Exit Do
            Else
                Dict(FindCell.Address) = 1
            End If
        Loop

    Set FindAll = TempRange
End Function

結果、とりあえず無限ループはしなくなったわけだが、今もって最初の原因が分かっていない。また、つまらぬお茶の濁し方をしてしまった（五右衛門風）。

ということで、今回はあまり参考にならないお話でした。