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

Question

I'm writing a function which takes a column range and finds the first and last cell in that column which have a certain value. This gives a first row number and a last row number that are then used to return the corresponding subrange in another column.
The idea is that with this function I can apply Excel functions to a (continuous) subsection of a range. Eg suppose I have a table with various prices of Apples and Bananas, grouped so that all prices of Apples come first, then Bananas. I want to find the minimum price of Apples and the minimum of Bananas, but selecting the whole range and without changing the range over which to minimise. I would use my desired function to feed a range to Excel's MIN function which included just Apples, or just Bananas, without having to manually select these subranges. A MINIF, if you will - like a weak version of SUMIF but for MIN (and potentially many other functions).
I've found a way of doing it but it's running really quite slow. I think it may have to do with the for loop, but I don't understand enough about efficiency in Excel/VBA to know how to improve it. I'm using this code on an Excel table, so the columns I pass are named columns of a table object. I'm using Excel 2010 on Windows 7 Enterprise.

Grateful for any help. Even solutions on how to conditionally apply functions to ranges that deviate radically from this are well received.

Code:

' 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

I don't like using VBA when an Excel formula can be used efficiently.

First of all, you can get a minimum or maximum according to conditions using a simple IF in an array formula (enter the formula using Ctrl + Shift + Enter . This will add the surrounding {} that indicate an array formula):

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

This formula checks in A for the condition in D1 and returns the corresponding value from B. Notice that your data doesn't even need to be ordered for this formula to work:

Second, if you want to keep getting the first and last row numbers, you can use this very formula with a minor addition. However , I suspect that one would use the INDIRECT or OFFSET functions with these values, which is unnecessary and inefficient, as this functions are volatile. Regardless, the addition to the formula is the ROW function. (This formula will need the data to be ordered of course). Array formula for row numbers:

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

This will return the last row number for Bananas .

Answer 2

By settiing Find SearchDirection to xlPrevious you can easily Find the last occurrence in a range.
Toggling Application.ScreenUpdating has little effect when you are just reading values. I prefer shorter variable names. Longer names tend to clutter the screen and make it harder to see what's going on. But's that's just my opinion.

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

My answer is similar to the VBA UDF solution posted earlier by Thomas Inzina with a couple of differences.

The After:= parameter is used to ensure that the first match found is the first match in the range. The Range.Find method uses a 'tin-can' approach where it loops through the cells of hte range and restarts at the beginning once it reaches the end. By starting After:=.Cells(.Cells.Count) and moving in a forward direction, you will find hte first cell in the range that matches. Similarly, by starting at After:=.Cells(1) and moving SearchDirection:=xlPrevious you will quickly find the last without looping.

I've also used the Intersect method to a) cut down full column references to the Worksheet.UsedRange property and b) to quickly return the working range from the determined criteria range.

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