Excel UDF查找具有给定值的范围中的第一个和最后一个单元格 – 运行缓慢
我正在写一个函数，它需要一个列的范围，并find该列中的第一个和最后一个单元格有一定的价值。 这给出了第一个行号和最后一个行号，然后用于返回另一列中相应的子范围。
这个想法是使用这个函数，我可以将Excel函数应用到一个范围的（连续的）子部分。 例如，假设我有一个苹果和香蕉价格不同的表，所以苹果的所有价格都是先来的，然后是香蕉。 我想find苹果的最低价格和香蕉的最低限度，但select整个范围，而不改变最小化的范围。 我将使用我所需的function来提供范围到Excel的MINfunction，其中只包括苹果，或只是香蕉，而不必手动select这些子范围。 一个MINIF，如果你愿意的话 – 就像SUMIF的一个弱版本，但是对于MIN（可能还有许多其他function）。
我find了一个办法，但是运行速度非常慢。 我认为这可能与for循环有关，但是我不太了解Excel / VBA的效率以了解如何改进它。 我在Excel表上使用这个代码，所以我传递的列是一个表对象的命名列。 我在Windows 7 Enterprise上使用Excel 2010。
感谢任何帮助。 即使是有条件地将函数应用于与此相背离的范围的解决scheme也是受到欢迎的。
码：
' ParentRange and CriterionRange are columns of the same table. 'I want to extract a reference to the part of ParentRange which corresponds 'by rows to the part of CriterionRange that contains cells with a certain value. Function CorrespondingSubrange(CriterionRange As Range, Criterion As _ String, ParentRange As Range) As Range Application.ScreenUpdating = False Dim RowCounter As Integer Dim SubRangeFirstRow As Integer Dim SubRangeFirstCell As Range Dim SubRangeLastRow As Integer Dim SubRangeLastCell As Range Dim RangeCountStarted As Boolean RangeCountStarted = False Set SubRangeFirstCell = CriterionRange.Find(What:=Criterion, LookIn:=xlValues, _ LookAt:=xlPart, SearchOrder:=xlByColumns, SearchDirection:=xlNext, _ MatchCase:=False, SearchFormat:=False) If Not (SubRangeFirstCell Is Nothing) Then RangeCountStarted = True SubRangeFirstRow = SubRangeFirstCell.Row - CriterionRange.Range("A1").Row + 1 For RowCounter = SubRangeFirstRow To CriterionRange.Cells.Count If Not (CriterionRange.Cells(RowCounter, 1).Value = Criterion) Then SubRangeLastRow = RowCounter - 1 Exit For End If Next End If If RangeCountStarted = True And SubRangeLastRow = 0 Then SubRangeLastRow = RowCounter Set CorrespondingSubrange = ParentRange.Range("A" & SubRangeFirstRow & ":A" & SubRangeLastRow) Application.ScreenUpdating = True End Function 我不喜欢使用VBA时，可以有效地使用Excel公式。
首先，你可以根据条件使用一个简单的IF在数组公式中得到一个最小值或最大值（使用Ctrl + Shift + Enterinput公式，这将添加指示数组公式的公式）：
=MIN(IF($A$1:$A$10=D1,$B$1:$B$10))
此公式在A中检查D1中的条件，并从B中返回相应的值。请注意，您的数据甚至不需要为此公式工作：
其次，如果你想继续得到第一行和最后一行的数字，你可以使用这个非常小的公式。 但是 ，我怀疑，这些值将使用INDIRECT或OFFSET函数，这是不必要的和低效的，因为这个函数是不稳定的。 无论如何，公式的补充是ROW函数。 （这个公式当然需要数据来sorting）。 行号的数组公式 ：
=MAX(IF($A$1:$A$10=D1,ROW($A$1:$A$10)))
这将返回香蕉的最后一行数字。
通过将Find SearchDirection设置为xlPrevious，您可以轻松地find范围中的最后一个事件。
切换Application.ScreenUpdating只是读取值时几乎没有影响。 我更喜欢较短的variables名称。 更长的名字往往会使屏幕变得混乱，使得难以看清发生了什么。 但是这只是我的意见。
Function CorrespondingSubrange(rCriterion As Range, Criterion As _ String, rParent As Range) As Range Dim FirstCell As Range Dim LastCell As Range Set FirstCell = rCriterion.Find(What:=Criterion, LookIn:=xlValues, _ LookAt:=xlPart, SearchOrder:=xlByColumns, SearchDirection:=xlNext, _ MatchCase:=False, SearchFormat:=False) Set LastCell = rCriterion.Find(What:=Criterion, LookIn:=xlValues, _ LookAt:=xlPart, SearchOrder:=xlByColumns, SearchDirection:=xlPrevious, _ MatchCase:=False, SearchFormat:=False) If Not (FirstCell Is Nothing) Then Set CorrespondingSubrange = rParent.Range("A" & FirstCell.Row & ":A" & LastCell.Row) End If End Function
我的答案与Thomas Inzina早些时候发布的VBA UDF解决scheme类似， 只是有一些不同之处。
After:=参数用于确保find的第一个匹配项是范围中的第一个匹配项。 Range.Find方法使用“锡jar（tin-can）”方法，通过hte范围的单元格循环，一旦达到结束就重新开始。 通过启动After:=.Cells(.Cells.Count)并向前移动，你会发现第一个单元格在匹配范围内。 同样，从After:=.Cells(1)并移动SearchDirection:=xlPrevious您将很快find没有循环的最后一个。
我也使用Intersect方法 a）减less对Worksheet.UsedRange属性的完整列引用，以及b）快速从确定的标准范围返回工作范围。
Function CorrespondingSubrange(rngCriterion As Range, Criterion As String, _ rngWorking As Range) As Variant Dim SubRangeFirstCell As Range Dim SubRangeLastCell As Range 'set the return value to an #N/A error (success will overwrite this) CorrespondingSubrange = CVErr(xlErrNA) 'chop any full column references down to manageable ranges Set rngCriterion = Intersect(rngCriterion, rngCriterion.Parent.UsedRange) With rngCriterion 'look forwards for the first occurance Set SubRangeFirstCell = .Find(What:=Criterion, After:=.Cells(.Cells.Count), _ LookIn:=xlValues, LookAt:=xlPart, SearchOrder:=xlByColumns, _ SearchDirection:=xlNext, MatchCase:=False, SearchFormat:=False) If Not SubRangeFirstCell Is Nothing Then 'there is at least one of the criteria - now look backwards Set SubRangeLastCell = .Find(What:=Criterion, After:=.Cells(1), _ LookIn:=xlValues, LookAt:=xlPart, SearchOrder:=xlByColumns, _ SearchDirection:=xlPrevious, MatchCase:=False, SearchFormat:=False) Set CorrespondingSubrange = Intersect(rngWorking, Range(SubRangeFirstCell, SubRangeLastCell).EntireRow) Debug.Print CorrespondingSubrange.Address(0, 0, external:=True) End If End With End Function
