Excel UDF 查找范围内具有给定值的第一个和最后一个单元格 - 运行缓慢

Question

我正在编写一个函数，它接受一个列范围并找到该列中具有特定值的第一个和最后一个单元格。这给出了第一行号和最后一行号，然后用于 return 另一列中的相应子范围。
这个想法是，通过这个函数，我可以将 Excel 函数应用于范围的（连续）子部分。例如。假设我有一个 table，其中包含各种价格的苹果和香蕉，它们被分组以便所有苹果的价格排在第一位，然后是香蕉。我想找到苹果的最低价格和香蕉的最低价格，但是 select 计算整个范围并且不改变要最小化的范围。我会使用我想要的函数将范围提供给 Excel 的 MIN 函数，其中仅包括苹果或香蕉，而无需手动 select 这些子范围。一个 MINIF，如果你愿意 - 就像 SUMIF 的弱版本，但用于 MIN（以及可能的许多其他功能）。
我找到了一种方法，但是运行真的很慢。我认为这可能与 for 循环有关，但我对 Excel/VBA 中的效率了解不够，不知道如何改进它。我在 Excel table 上使用此代码，因此我传递的列被命名为 table 对象的列。我在 Windows 7 Enterprise 上使用 Excel 2010。

感谢您的帮助。甚至关于如何有条件地将函数应用于与此根本偏离的范围的解决方案也很受欢迎。

代码：

' 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

Answer 1

我不喜欢使用 VBA，因为可以有效地使用 Excel 公式。

首先，你可以在一个数组公式中使用简单的IF根据条件得到最小值或最大值（输入公式使用Ctrl + Shift + Enter. 这样会加上表示数组公式的周围{}:

=MIN(IF($A:$A=D1,$B:$B))

此公式在 A 中检查 D1 中的条件，returns 来自 B 的相应值。请注意，您的数据甚至不需要排序即可使此公式起作用：

其次，如果您想继续获取第一个和最后一个行号，您可以使用这个公式并进行少量添加。但是，我怀疑有人会使用具有这些值的INDIRECT 或OFFSET 函数，这是不必要且低效的，因为这些函数是易变的。无论如何，添加到公式的是 ROW 函数。（这个公式当然需要订购数据）。 行号的数组公式：

=MAX(IF($A:$A=D1,ROW($A:$A)))

这将 return Bananas 的最后一行编号。

Answer 2

通过将 Find SearchDirection 设置为 xlPrevious，您可以轻松地找到范围内的最后一个匹配项。
当您只是读取值时，切换 Application.ScreenUpdating 几乎没有影响。我更喜欢较短的变量名。较长的名称往往会使屏幕变得混乱，并且更难看到正在发生的事情。但这只是我的意见。

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

Answer 3

我的回答类似于 Thomas Inzina 之前发布的 VBA UDF 解决方案，但有一些不同。

After:=参数用于确保找到的第一个匹配项是范围内的第一个匹配项。 Range.Find method 使用 'tin-can' 方法，它循环遍历 hte 范围的单元格，并在到达末尾时从头开始重新启动。通过开始 After:=.Cells(.Cells.Count) 并向前移动，您将找到匹配范围内的第一个单元格。同样，从 After:=.Cells(1) 开始并移动 SearchDirection:=xlPrevious，您将很快找到最后一个，而无需循环。

我还使用 Intersect method to a) cut down full column references to the Worksheet.UsedRange property 和 b) 从确定的标准范围快速 return 工作范围。

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

Excel UDF 查找范围内具有给定值的第一个和最后一个单元格 - 运行缓慢

Excel UDF to find first and last cell in range with a given value - runs slowly

excel

performance

vba

user-defined-functions