自作マクロ機能のAIアップグレード：FindAll

生成系ＡＩの出現により、ここ数年で色々なものが随分と様変わりした。
最近ではExcel VBAにおいても、仕様をAIに伝えて作ってもらうことが多くなった。

そこで今回は、以前作成したものの「いまいち」だったマクロを、改めてAIに添削してもらった。素材となるのはこちら。
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 FirstAddress As String
    Dim TempRange As Range

    ' 最初の一致を見つける
    Set FindCell = target_range.Find(What:=faWhat, _
                                     LookIn:=faLookIn, _
                                     LookAt:=faLookAt, _
                                     MatchCase:=faMatchCase, _
                                     MatchByte:=faMatchByte)
    
    ' 一致するものがない場合、関数を終了する
        If FindCell Is Nothing Then
            Exit Function
        End If
    
    ' 最初に見つかったセルのアドレスを保存する
        FirstAddress = FindCell.Address
    Set TempRange = FindCell
    
    ' すべての一致を見つけるためにループ
        Do
            Set FindCell = target_range.FindNext(FindCell)
            If FindCell Is Nothing Then Exit Do ' セーフティチェック
            If FindCell.Address = FirstAddress Then Exit Do
            ' 新しいセルが既にTempRangeに含まれていないかを確認
            If Intersect(TempRange, FindCell) Is Nothing Then
                Set TempRange = Union(TempRange, FindCell)
            End If
        Loop
    
    ' 一致するすべての範囲を返す
    Set FindAll = TempRange
End Function

なるほど、確かにすっきりした。しかし、丸投げはよくない。テストしよう。

Sub test()

    FindAll(ActiveSheet.Cells, "ターゲット").Interior.Color = vbRed

End Sub

結果がこちら。

AIさん、さすがです。
ご参考まで。