我需要帮助来创建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 

也记，因为这只会做标准=而不是任何其他功能一样>，<，<>，....