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

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 函数吗？

I need help to create a miniifs vba function?

vba

excel-2010

maxifs