Attribute VB_Name = "ExFunc"
'''
''' 拡張関数
'''

'''[拡張関数一覧]
''' maxif(範囲, 検索条件, 最大範囲)
''' minif(範囲, 検索条件, 最小範囲)

''' <summary>
'''   条件に合致した範囲の最大値を返す
''' </summary>
Public Function maxif(範囲 As Range, 検索条件 As String, Optional 最大範囲 As Range) As Variant
    maxif = setif("max", 範囲, 検索条件, 最大範囲)
End Function

''' <summary>
'''   条件に合致した範囲を最小値を返す
''' </summary>
Public Function minif(範囲 As Range, 検索条件 As String, Optional 最小範囲 As Range) As Variant
    minif = setif("min", 範囲, 検索条件, 最小範囲)
End Function

Public Function setif(mode As String, 範囲 As Range, 検索条件 As String, Optional 指定範囲 As Range) As Variant
    Dim base        As Range
    Dim position    As Range
    Dim rr          As Range
    Dim result      As Variant

    If 指定範囲 Is Nothing Then
        Set base = 範囲
    Else
        Set base = 指定範囲
    End If
    
    result = False
    For Each rr In 範囲
        Set position = base.Worksheet.Cells(base.Row + (rr.Row - 範囲.Row), base.Column + (rr.Column - 範囲.Column))
    
        Select Case Left(検索条件, 2)
        Case ">=", "<=", "!=", "<>", "=="
            If match(Left(検索条件, 2), rr, Mid(検索条件, 3)) Then
                result = setV(mode, result, position.Value)
            End If
        Case Else
            Select Case Left(検索条件, 1)
            Case ">", "<", "="
                If match(Left(検索条件, 1), rr, Mid(検索条件, 2)) Then
                    result = setV(mode, result, position.Value)
                End If
            Case Else
                If match("=", rr, 検索条件) Then
                    result = setV(mode, result, position.Value)
                End If
            End Select
        End Select
    Next
    
    If VarType(result) = vbBoolean And Not result Then
        result = 0
    End If
    
    setif = result
End Function
    
Private Function match(condition As String, rr As Range, s As String) As Boolean
    Dim v As Variant

    If IsDate(s) Then
        v = CDate(s)
    ElseIf IsNumeric(s) Then
        v = CDbl(s)
    Else
        v = CStr(s)
    End If
    
    If VarType(rr.Value) <> VarType(v) Then
        match = False
    Else
        Select Case condition
        Case ">="
            match = (rr.Value >= v)
        Case "<="
            match = (rr.Value <= v)
        Case "!=", "<>"
            match = (rr.Value <> v)
        Case ">"
            match = (rr.Value > v)
        Case "<"
            match = (rr.Value < v)
        Case Else
            match = (rr.Value = v)
        End Select
    End If
    
End Function

Private Function setV(mode As String, v1 As Variant, v2 As Variant) As Variant

    If VarType(v2) <> vbDate And VarType(v2) <> vbDouble Then
        setV = v1
    ElseIf VarType(v1) = vbBoolean And Not v1 Then
        setV = v2
    ElseIf mode = "max" Then
        setV = IIf(v2 > v1, v2, v1)
    ElseIf mode = "min" Then
        setV = IIf(v2 < v1, v2, v1)
    Else
        setV = v1
    End If

End Function

''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''