ユーザー定義関数：MAXIFS・MINIFS（Excel 2013以前向け）

0.README.md

ユーザー定義関数：MAXIFS・MINIFS（Excel 2013以前向け）

Excel 2016 以降に追加された MAXIFS・MINFS を Excel 2013 以前でも使えるようにするユーザー定義関数。

→ 他の幾つかの関数も含めてアドイン化したもの (Excel2016Func)を公開しているので、そちらをご参照下さい。

MAXIFS.vba

Function MAXIFS(max_range As Range, ParamArray criteria_list())
    Dim max_range_value_array As Variant
    Dim max_range_width As Integer
    Dim max_range_height As Integer
    Dim row_index As Integer
    Dim column_index As Integer
    
    Dim criteria_range_array() As Range
    Dim criteria_range_value_array() As Variant
    Dim criteria_condition_array As Variant
    Dim criteria_number As Integer
    Dim criteria_index As Integer
    
    Dim is_valid As Boolean
    Dim max_value As Variant
    
    MAXIFS = CVErr(xlErrValue)
    
    criteria_number = UBound(criteria_list) - LBound(criteria_list) + 1
    
    If criteria_number Mod 2 <> 0 Then
        'On Error Resume Next
        'Err.Raise Number:=450 ' 引数の数が一致していません。または不正なプロパティを指定しています。
        'MsgBox CStr(Err.Number) & " : " & Err.Description
        'Err.Clear
        'On Error GoTo 0
        Exit Function
    End If
    
    criteria_number = criteria_number / 2
    ReDim criteria_range_array(criteria_number)
    ReDim criteria_range_value_array(criteria_number)
    ReDim criteria_condition_array(criteria_number)
    
    max_range_value_array = max_range
    
    max_range_height = UBound(max_range_value_array)
    max_range_width = UBound(max_range_value_array, 2)
    
    For criteria_index = 1 To criteria_number
        Set criteria_range_array(criteria_index) = criteria_list((criteria_index - 1) * 2)
        criteria_range_value_array(criteria_index) = criteria_list((criteria_index - 1) * 2)
        criteria_condition_array(criteria_index) = criteria_list((criteria_index - 1) * 2 + 1)
        
        If (UBound(criteria_range_value_array(criteria_index)) <> max_range_height) Or _
            (UBound(criteria_range_value_array(criteria_index), 2) <> max_range_width) _
        Then
            Exit Function
        End If
    Next criteria_index
    
    max_value = Empty
    
    For row_index = 1 To max_range_height
        For column_index = 1 To max_range_width
            is_valid = True
            
            For criteria_index = 1 To criteria_number
                ' TODO: 条件が式の場合に正しく動作しない→作り込みが困難なため、COUNTIF()を利用
                'If criteria_range_value_array(criteria_index)(row_index, column_index) <> criteria_condition_array(criteria_index) Then
                '    is_valid = False
                '    Exit For
                'End If
                
                If Application.WorksheetFunction.CountIf( _
                        criteria_range_array(criteria_index).Offset(row_index - 1, column_index - 1).Cells(1, 1), _
                        criteria_condition_array(criteria_index) _
                    ) = 0 _
                Then
                    is_valid = False
                    Exit For
                End If
            Next criteria_index
            
            If is_valid = True Then
                If max_value = Empty Then
                    max_value = max_range_value_array(row_index, column_index)
                Else
                    max_value = Application.WorksheetFunction.Max(max_value, max_range_value_array(row_index, column_index))
                End If
            End If
        Next column_index
    Next row_index
    
    If max_value <> Empty Then
        MAXIFS = max_value
    Else
        MAXIFS = 0
    End If
End Function

MINIFS.vba

Function MINIFS(min_range As Range, ParamArray criteria_list())
    Dim min_range_value_array As Variant
    Dim min_range_width As Integer
    Dim min_range_height As Integer
    Dim row_index As Integer
    Dim column_index As Integer
    
    Dim criteria_range_array() As Range
    Dim criteria_range_value_array() As Variant
    Dim criteria_condition_array As Variant
    Dim criteria_number As Integer
    Dim criteria_index As Integer
    
    Dim is_valid As Boolean
    Dim min_value As Variant
    
    MINIFS = CVErr(xlErrValue)
    
    criteria_number = UBound(criteria_list) - LBound(criteria_list) + 1
    
    If criteria_number Mod 2 <> 0 Then
        'On Error Resume Next
        'Err.Raise Number:=450 ' 引数の数が一致していません。または不正なプロパティを指定しています。
        'MsgBox CStr(Err.Number) & " : " & Err.Description
        'Err.Clear
        'On Error GoTo 0
        Exit Function
    End If
    
    criteria_number = criteria_number / 2
    ReDim criteria_range_array(criteria_number)
    ReDim criteria_range_value_array(criteria_number)
    ReDim criteria_condition_array(criteria_number)
    
    min_range_value_array = min_range
    
    min_range_height = UBound(min_range_value_array)
    min_range_width = UBound(min_range_value_array, 2)
    
    For criteria_index = 1 To criteria_number
        Set criteria_range_array(criteria_index) = criteria_list((criteria_index - 1) * 2)
        criteria_range_value_array(criteria_index) = criteria_list((criteria_index - 1) * 2)
        criteria_condition_array(criteria_index) = criteria_list((criteria_index - 1) * 2 + 1)
        
        If (UBound(criteria_range_value_array(criteria_index)) <> min_range_height) Or _
            (UBound(criteria_range_value_array(criteria_index), 2) <> min_range_width) _
        Then
            Exit Function
        End If
    Next criteria_index
    
    min_value = Empty
    
    For row_index = 1 To min_range_height
        For column_index = 1 To min_range_width
            is_valid = True
            
            For criteria_index = 1 To criteria_number
                ' TODO: 条件が式の場合に正しく動作しない→作り込みが困難なため、COUNTIF()を利用
                'If criteria_range_value_array(criteria_index)(row_index, column_index) <> criteria_condition_array(criteria_index) Then
                '    is_valid = False
                '    Exit For
                'End If
                
                If Application.WorksheetFunction.CountIf( _
                        criteria_range_array(criteria_index).Offset(row_index - 1, column_index - 1).Cells(1, 1), _
                        criteria_condition_array(criteria_index) _
                    ) = 0 _
                Then
                    is_valid = False
                    Exit For
                End If
            Next criteria_index
            
            If is_valid = True Then
                If min_value = Empty Then
                    min_value = min_range_value_array(row_index, column_index)
                Else
                    min_value = Application.WorksheetFunction.Min(min_value, min_range_value_array(row_index, column_index))
                End If
            End If
        Next column_index
    Next row_index
    
    If min_value <> Empty Then
        MINIFS = min_value
    Else
        MINIFS = 0
    End If
End Function

6 new Excel functions that simplify your formula editing experience - Office Blogs
で書かれている通り、Office 365（Office 2016）にて新規に追加された Excel の関数には

• TEXTJOIN
• CONCAT
• IFS
• SWITCH
• MAXIFS
• MINIFS

の6つがあり、これらは Excel 2013 以前のバージョンでは使用することが出来ません。

このうちの、TEXTJOIN、CONCAT、IFS、SWITCH については、
関数リファレンス | 経理・会計事務所向けエクセルスピードアップ講座
にてユーザー定義関数が紹介されていました。

今のところそこに含まれていなかった MAXIFS、MINIFS についてのみ、ユーザー定義関数を実装してみました。

動作保証はありませんが、

• MAXIFS 関数 - Office サポート
• MINIFS 関数 - Office サポート

のページにそれぞれ書かれていた例については、一応パスしています。

furyutei/Excel2016Func: Excel2013以前で未サポートのワークシート関数の一部を疑似的に使用可能にするアドイン

をインストールすることで、Excel 2013以前のバージョンでも

• TEXTJOIN
• CONCAT
• IFS
• SWITCH
• MAXIFS
• MINIFS

が疑似的に使用できるようになります。