为MAXIFs创建VBA代码

Question

我试图将来自其他帖子的代码改编为更易于理解的代码。在运行代码时，我仍然收到此行的“类型不匹配”错误：w(k) = z(i, 1)。有没有人有任何洞察到这个错误？

我的代码

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    

Answer 1

，因为你有兴趣出一些返回的最大值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 

，我也给变量赋予更多有意义的名称

Answer 2

在开始工作代码之后，一个限制就是您被限制为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 

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

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

Diedrich