为MAXifs创buildVBA代码
我试图将来自另一篇文章的代码改写成更容易理解的东西。 当运行代码时，我仍然得到这条线的错误“types不匹配”： 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
因为你有兴趣从某些选项中返回一个最大值来selectMaxRange范围，那么你只能遍历它的数值，并且只检查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
我也给variables赋予了更多有意义的名字
在开始工作之后，一个限制就是你被限制在两个条件之内。 我决定进一步采取这个代码来限制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