Excel 2016 以降に追加された MAXIFS・MINFS を Excel 2013 以前でも使えるようにするユーザー定義関数。
→ 他の幾つかの関数も含めてアドイン化したもの (Excel2016Func)を公開しているので、そちらをご参照下さい。
Excel 2016 以降に追加された MAXIFS・MINFS を Excel 2013 以前でも使えるようにするユーザー定義関数。
→ 他の幾つかの関数も含めてアドイン化したもの (Excel2016Func)を公開しているので、そちらをご参照下さい。
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 |
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 |
をインストールすることで、Excel 2013以前のバージョンでも
が疑似的に使用できるようになります。