Question

我做了一些宏，我升级了Diedrich的一个宏，在excel 2010中有一个MaxIfs，它使用了一行代码，我把代码放在了下面。

Public Function maxifs(MaxRange As Range, ParamArray Criteria() As Variant) As Variant
Application.Volatile
Dim n As Long
Dim i, j As Long
Dim c As Variant
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
    For j = 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, j).Value <> Criteria(c + 1) Then
            f = False
        End If

    Next c

    'Define z
    z = MaxRange

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

    Next j
Next i

maxifs = Application.Max(w)
Exit Function

ErrHandler:
maxifs = CVErr(xlErrValue)


End Function

所以现在我会做minifs，如果我的所有价值都是正面的话它就不起作用。

我该怎么办？

ps：如果你将这个宏的最大值改为中位数，它也会起作用

感谢您的回答。

Answer 1

这是因为您正在启动数组w并且空插槽为0，因为您填充的第一个插槽是插槽1.

所以w(0)是0，当所有其他人都是正数时，这是最小数字。
因此，在最初为K=-1分配值时，请更改K=0而不是k。

我也在循环前移动了z，没有理由继续分配该数组。它只需要分配一次。

另外，我稍微更改了范围，只查看使用的范围，这样就可以使用完整的列引用。

此外，循环需要通过行和列而不是两个循环遍及整个范围，因为它会导致许多不必要的循环。

Public Function minifs(MaxRange As Range, ParamArray Criteria() As Variant) As Variant
Application.Volatile
Dim n As Long
Dim i, j As Long
Dim c As Variant
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 z
z = Intersect(MaxRange, MaxRange.Parent.UsedRange).Value
'Define k
k = -1

'Loop through cells of max range
For i = 1 To UBound(z, 1)
    For j = 1 To UBound(z, 2)

'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 Intersect(Criteria(c), Criteria(c).Parent.UsedRange).Cells(i, j).Value <> Criteria(c + 1) Then
            f = False
        End If

    Next c



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

    Next j
Next i

minifs = Application.Min(w)
Exit Function

ErrHandler:
minifs = CVErr(xlErrValue)


End Function

另请注意，这只会在条件中=而不是>，<，<>，....

我需要帮助来创建一个miniifs vba函数吗？

1 个答案: