SUMIF関数で非表示のレコードを無視したい ③ 結局は足し算

昨日は、SUMIF関数で非表示のレコードを無視する方法を別の切り口から行うために、全ての検索結果をRange型で返すユーザー定義関数を作成してみた。
infoment.hatenablog.com

本日はこれを、自作のSUMIF関数もどきに組み込んでみる。

改めて流れを整理すると、こんな感じだ。

1. SUMIFの「範囲」に相当する範囲を、SUMIFの「検索条件」で検索。
2. 検索は、昨日作成したユーザー定義関数「FindAll」で行う。
3. FindAllの戻り値をオフセットさせ、SUMIFの「合計範囲」に相当する範囲を得る。
4. ３．の合計範囲にある数値を、ひたすら足し算する。

これを、先日作成した関数に反映してみた。

Function SumIf_OnlyNotHidden(target_range As Range, _
                             search_condition As String, _
                             total_range As Range) As Long

    If target_range.Columns.Count > 1 Then Exit Function
    If total_range.Columns.Count > 1 Then Exit Function

    Dim ⊿C As Long
        ⊿C = total_range.Column - target_range.Column

    Dim TempSum As Long

    ' ↓今回変更した範囲。
    Dim VisibleTargetRange As Range
    Set VisibleTargetRange = FindAll(target_range, search_condition)
        If Not VisibleTargetRange Is Nothing Then
            Dim r As Range
                For Each r In VisibleTargetRange.Offset(, ⊿C)
                    TempSum = TempSum + r.Value
                Next
        End If
        SumIf_OnlyNotHidden = TempSum
End Function

これを行うにあたり、問題が発生した。昨日のサンプルでは上手くいったのに、なぜかユーザー定義関数内から呼び出すと、FindNextが上手く機能しないのだ。
仕方が無いので、Findで「After」を指定することで対処した（昨日掲載のコードも修正済みです）。

結果は、こんな感じだ。

本来であれば、単価の列はVlookup関数で賄いたいところだが、即応性がどの程度か確認するために、他の関数は除外した。
結果、2000レコード程度であっても、上記動画でご覧のとおり、処理に一瞬の間があいてしまう。やはり運用としては、

1. 通常は、ピボットテーブルを使用する。
2. どうしてもピボットテーブルが付かない場合、今回の関数使用を検討する。

ということになりそうです。

◆今回の全ソースコード（クリックで展開）◆

Function SumIf_OnlyNotHidden(target_range As Range, _
                             search_condition As String, _
                             total_range As Range) As Long

    If target_range.Columns.Count > 1 Then Exit Function
    If total_range.Columns.Count > 1 Then Exit Function

    Dim ⊿C As Long
        ⊿C = total_range.Column - target_range.Column

    Dim TempSum As Long

    Dim VisibleTargetRange As Range
    Set VisibleTargetRange = FindAll(target_range, search_condition)
        If Not VisibleTargetRange Is Nothing Then
            Dim r As Range
                For Each r In VisibleTargetRange.Offset(, ⊿C)
                    TempSum = TempSum + r.Value
                Next
        End If
        SumIf_OnlyNotHidden = TempSum
End Function

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

参考まで。