Question

我正在编写一个函数，它接受一个列范围并找到该列中具有特定值的第一个和最后一个单元格。这给出了第一行编号和最后一行编号，然后用于返回另一列中的相应子范围我的想法是，使用此功能，我可以将Excel函数应用于范围的（连续）子部分。例如。假设我有一张苹果和香蕉的各种价格的桌子，这样的分组使苹果的所有价格首先出现，然后是香蕉。我想找到苹果的最低价格和香蕉的最低价格，但是选择整个范围并且不改变最小化的范围。我会使用我想要的功能将范围提供给Excel的MIN功能，其中只包括苹果或香蕉，而不必手动选择这些子范围。一个MINIF，如果你愿意的话 - 就像SUMIF的弱版本，但是对于MIN（以及可能的许多其他功能）我找到了一种方法，但它的运行速度非常慢。我认为它可能与for循环有关，但我不太了解Excel / VBA中的效率以了解如何改进它。我在Excel表上使用此代码，因此我传递的列被命名为表对象的列。我在Windows 7企业版上使用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

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

首先，您可以使用数组公式中的简单IF根据条件获得最小值或最大值（使用 Ctrl + Shift + Enter <输入公式< / kbd>。这将添加表示数组公式的周围{}：

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

此公式在A中检查D1中的条件并从B返回相应的值。请注意，甚至无需订购您的数据以使此公式起作用：

其次，如果你想继续获得第一行和最后一行的数字，你可以使用这个非常公式，只需要一个小的补充。但是，我怀疑会使用这些值的INDIRECT或OFFSET函数，这是不必要且效率低的，因为此函数是易失性的。无论如何，公式的加法是ROW函数。（当然，这个公式需要订购数据）。行号的数组公式：

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

这将返回 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使用了“罐头”和“罐头”。接近它通过hte范围的单元格的方法，并在它到达结束时重新开始。通过启动After:=.Cells(.Cells.Count)并向前移动，您将找到匹配范围内的第一个单元格。同样，从After:=.Cells(1)开始并移动SearchDirection:=xlPrevious，您将很快找到最后一个没有循环的内容。

我还使用了Intersect method来减少对Worksheet.UsedRange property和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

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

3 个答案: