在VBA中如何find除了行之外的最小值有特殊字的行

我试图在范围exep行中find最小值的行有特殊的词。 对于EX:

在这里输入图像说明

现在,我想find一排最less有“西瓜”的水果。 而结果应该是5排(香蕉排)

我的想法是find第二低的价值

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

然后我们会find这个值的行

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

但是如果:

在这里输入图像描述

这将是错误的,我不知道是否有任何function或方式做这样的行最小值除了行有特殊的字

使用这个公式。

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

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

在这里输入图像描述

根据您的评论编辑更新公式。

 =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 

在工作表中使用

在这里输入图像描述

使用Range AutoFilter()和WorksheetFunction Min()方法,代码更短,无需声明循环和variables:

 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 

我会尝试以不同的方式来处理它。 首先我会过滤出“ 西瓜 ”一行。

然后遍历只包含可见单元格的Range(使用SpecialCells(xlCellTypeVisible)) ),并find最小值。

 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