为 MAXifs 创建 VBA 代码

Create VBA code for MAXifs

提问by Diedrich

I have tried to adapt code from another post into something easier for me to understand. When running the code, I still get an error "Type mismatch" for this line: w(k) = z(i, 1). Does anyone have any insight into this error?

我试图将另一篇文章中的代码改编成更容易理解的东西。运行代码时，我仍然收到以下行的错误“类型不匹配”：w(k) = z(i, 1)。有没有人对这个错误有任何见解？

My Code

我的代码

Option Base 1

Function MaxIf(MaxRange As Range, Lookup_Range1 As Range, Var_Range1 As Variant, _
                Lookup_Range2 As Range, Var_Range2 As Variant) As Variant

    Dim x() As Variant, y() As Variant, z() As Variant, w() As Long
    Dim i As Long
    Dim Constraint1 As Variant, Constraint2 As Variant, k As Long

    i = 1
    k = 0
    Constraint1 = Var_Range1
    Constraint2 = Var_Range2
    x = Lookup_Range1
    y = Lookup_Range2
    z = MaxRange

    For i = 1 To Lookup_Range1.Rows.Count
        If x(i, 1) = Var_Range1 Then
            If y(i, 1) = Var_Range2 Then
                k = k + 1
                ReDim Preserve w(k)
                w(k) = z(i, 1)
            End If
        End If
    Next i
    MaxIf = Application.Max(w)

End Function            

回答by Diedrich

After getting to code to work, a limitation was that you are restricted to 2 conditions. I decided to take this code further to not restrict the number of conditions for the MaxIfs function. Please see the code here:

在开始编写代码后，一个限制是您仅限于 2 个条件。我决定进一步使用此代码，以不限制 MaxIfs 函数的条件数。请在此处查看代码：

    Function MaxIfs(MaxRange As Range, ParamArray Criteria() As Variant) As Variant
    Dim n As Long
    Dim i As Long
    Dim c As Long
    Dim f As Boolean
    Dim w() As Long
    Dim k As Long
    Dim z As Variant

    'Error if less than 1 criteria
    On Error GoTo ErrHandler
    n = UBound(Criteria)
    If n < 1 Then
        'too few criteria
        GoTo ErrHandler
    End If

    'Define k
    k = 0

    'Loop through cells of max range
    For i = 1 To MaxRange.Count

    'Start by assuming there is a match
    f = True

        'Loop through conditions
        For c = 0 To n - 1 Step 2

            'Does cell in criteria range match condition?
            If Criteria(c).Cells(i).Value <> Criteria(c + 1) Then
                f = False
            End If

        Next c

        'Define z
        z = MaxRange

        'Were all criteria satisfied?
        If f Then
            k = k + 1
            ReDim Preserve w(k)
            w(k) = z(i, 1)
        End If

    Next i

    MaxIfs = Application.Max(w)

    Exit Function
    ErrHandler:
    MaxIfs = CVErr(xlErrValue)

End Function

This code allows 1 to multiple conditions.

此代码允许 1 到多个条件。

This code was developed with reference to multiple code posted by Hans V over at Eileen's Lounge.

此代码是参考 Hans V 在 Eileen's Lounge 发布的多个代码开发的。

Diedrich

迪德里希

回答by user3598756

since you're interested in returning a maximum value out of some to choose between MaxRangerange, then you could loop through its numericvalues only and check conditions in corresponding cells of Lookup_Range1and Lookup_Range2only, like follows:

因为你有兴趣出一些返回的最大值之间进行选择MaxRange范围，通过它，那么你可以循环数字只值和检查条件，相应的细胞Lookup_Range1和Lookup_Range2唯一，像如下：

Function MaxIF(MaxRange As Range, Lookup_Range1 As Range, Var_Range1 As Variant, _
                Lookup_Range2 As Range, Var_Range2 As Variant) As Variant

    Dim LU1 As Variant, LU2 As Variant
    Dim founds As Long
    Dim cell As Range

    LU1 = Lookup_Range1.Value2 '<--| store Lookup_Range1 values
    LU2 = Lookup_Range2.Value2 '<--| store Lookup_Range2 values

    ReDim ValuesForMax(1 To MaxRange.Rows.count) As Long '<--| initialize ValuesForMax to its maximum possible size
    For Each cell In MaxRange.Columns(1).SpecialCells(xlCellTypeConstants, xlNumbers)
        If LU1(cell.row, 1) = Var_Range1 Then '<--| check 'Lookup_Range1' value in corresponding row of current 'MaxRange' cell
            If LU2(cell.row, 1) = Var_Range2 Then '<--| check 'Lookup_Range2' value in corresponding row of current 'MaxRange' cell
                founds = founds + 1
                ValuesForMax(founds) = CLng(cell) '<--| store current 'MaxRange' cell
            End If
        End If
    Next cell
    ReDim Preserve ValuesForMax(1 To founds) '<--| resize ValuesForMax to its actual values number
    MaxIF = Application.max(ValuesForMax)
End Function

where I also gave more meaningful names to variables

我还为变量赋予了更有意义的名称