如何在VBA中找到除行之外的最小值行

时间:2016-12-10 05:54:40

标签: excel vba excel-vba

我尝试在范围内找到行的最小值行有特殊字。 对于EX:

enter image description here

现在,我想找到一排水果,其中有最小数量的“西瓜”。 结果应该是5(香蕉行)

我的想法是找到第二低的值

SecLowVal = objExcel.WorksheetFunction.Small(Range("B2:B6"),2)

然后我们会找到这个值的行

For Each rngCell In Range("B2:B6")
    If rngCell.Value = SecLowVal Then
        Row = rngCell.Row
        Exit For
    End If
Next rngCell
msg(Row)

但是以防万一:

enter image description here

这将是错误的,我不知道是否有任何功能或方法可以找到除了行有特殊字之外的最小值行

3 个答案:

答案 0 :(得分:3)

使用此公式。

=CELL("row",INDEX(B2:B6,MATCH(MIN(IF(A2:A6<>"Watermelon",B2:B6,"")),B2:B6,0)))

CTRL + SHIFT + ENTER 来评估公式,因为它是一个数组公式。

enter image description here

根据您的评论修改更新公式。

=CELL("row",INDEX(B2:B6,MATCH(MIN(IF(A2:A6<>"Watermelon",B2:B6,"")),IF(A2:A6<>"Watermelon",B2:B6,""),0)))

CTRL + SHIFT + ENTER 来评估公式,因为它是一个数组公式。



=========================== VBA功能===================== =======

    Public Function MinBasedOnCondition(InRange As Range, valRange As Range, ConditionItem As String) As Variant
    Dim MyCell As Range
    Dim ValueArray()
    Dim MyArray()
    Dim CelCount, inc, MinVal, i As Long
    Dim Condition As String
    Dim ArrItems, Result

    Condition = ConditionItem
        CelCount = Application.CountIf(InRange, "<>" & Condition)
    ReDim ValueArray(CelCount)

    inc = 1

    For Each MyCell In InRange
        If MyCell.Value <> Condition Then
            ValueArray(inc) = MyCell.Offset(0, 1).Value
            inc = inc + 1
        End If
    Next

    ArrItems = ""
    For i = 1 To CelCount
        ArrItems = ArrItems & ValueArray(i) & ", "
    Next

    ArrItems = Left(ArrItems, Len(ArrItems) - 2)

    MyArray = Array(ArrItems)
    MinVal = Evaluate("Min(" & Join(MyArray, ",") & ")")

    For Each MyCell In valRange
        If MyCell.Offset(0, -1).Value <> Condition Then
            If MyCell.Value = MinVal Then
                Result = MyCell.Row
                    Exit For
            End If
        End If
    Next

    MinBasedOnCondition = Result
End Function


在工作表中使用

enter image description here

答案 1 :(得分:2)

使用Range AutoFilter()WorksheetFunction Min()方法,代码更短,没有声明循环或变量:

Function FindMinFilterWaterMelon() As Long
    With Range("A1", Cells(Rows.count, "A").End(xlUp))
        .AutoFilter Field:=1, Criteria1:="<>*Watermelon" ' show all values in range, except "Watermelon"
        With .Offset(, 1).SpecialCells(xlCellTypeVisible) '<--| reference column "B" filtered cells
            FindMinFilterWaterMelon = .Find(WorksheetFunction.Min(.Cells), , xlValues, xlWhole, xlByRows, xlNext).row '<--| get row of cell with minimum value
        End With
        .Parent.AutoFilterMode = False
    End With
End Function

可能的增强可能会将结果传递给丢弃:

Function FindMinFilterWaterMelon(fruitToDiscard As String) As Long
    With Range("A1", Cells(Rows.count, "A").End(xlUp))
        .AutoFilter Field:=1, Criteria1:="<>*" & fruitToDiscard ' show all values in range, except passed fruit to discard
        With .Offset(, 1).SpecialCells(xlCellTypeVisible) '<--| reference column "B" filtered cells
            FindMinFilterWaterMelon = .Find(WorksheetFunction.Min(.Cells), , xlValues, xlWhole, xlByRows, xlNext).row '<--| get row of cell with minimum value
        End With
        .Parent.AutoFilterMode = False
    End With
End Function

答案 2 :(得分:1)

我会尝试以不同的方式处理它。首先,我会过滤掉&#34; 西瓜&#34;行。

然后遍历仅包含可见单元格的范围(使用SpecialCells(xlCellTypeVisible))),并找到最小值。

<强>代码

Sub FindMinFilterWaterMelon()

Dim LastRow As Long, RowFound As Long
Dim MinVal, Rng As Range, cell As Range

Range("A1:B1").AutoFilter
LastRow = Cells(Rows.Count, "B").End(xlUp).Row

' show all values in range, except "Watermelon"
With Range("A1:B" & LastRow)
    .AutoFilter Field:=1, Criteria1:="<>*Watermelon*"
End With

' set range only to visible cells
Set Rng = Range("B2:B" & LastRow).SpecialCells(xlCellTypeVisible)

MinVal = 100000 ' init value of MinVal
' loop through all cells in Range visible cells and look for minimum value
For Each cell In Rng.Cells
    If cell.Value < MinVal Then
        MinVal = cell.Value
        RowFound = cell.Row
    End If
Next cell

MsgBox "Min value of " & MinVal & " was found at row " & RowFound

End Sub