Excel UDF zum ersten und letzten Zelle in Bereich mit einem bestimmten Wert finden - läuft langsam

Question

Ich schreibe eine Funktion, die einen Spaltenbereich und findet die erste und letzte Zelle in dieser Spalte, die einen bestimmten Wert haben. Dies ergibt eine erste Zeilennummer und eine letzte Zeilennummer, die dann verwendet werden, um den entsprechenden Unterbereich in einer anderen Spalte zurückzugeben.
Die Idee ist, dass ich mit dieser Funktion Excel-Funktionen auf einen (kontinuierlichen) Teilbereich eines Bereichs anwenden kann. Z.B. Angenommen, ich habe einen Tisch mit verschiedenen Preisen für Äpfel und Bananen, so gruppiert, dass alle Preise von Äpfeln zuerst kommen, dann Bananen. Ich möchte den Mindestpreis von Äpfeln und das Minimum von Bananen finden, aber den gesamten Bereich auswählen und ohne den Bereich zu ändern, über den minimiert werden soll. Ich würde meine gewünschte Funktion verwenden, um einen Bereich an Excel MIN-Funktion zu füttern, die nur Äpfel oder nur Bananen enthielt, ohne diese Teilbereiche manuell auswählen zu müssen. Ein MINIF, wenn Sie wollen - wie eine schwache Version von SUMMIF, aber für MIN (und möglicherweise viele andere Funktionen).
Ich habe einen Weg gefunden, es zu tun, aber es läuft wirklich ziemlich langsam. Ich denke, dass es mit der for-Schleife zu tun hat, aber ich verstehe nicht genug über die Effizienz in Excel/VBA, um zu wissen, wie man es verbessert. Ich verwende diesen Code in einer Excel-Tabelle, daher sind die Spalten, die ich übergebe, Spalten eines Tabellenobjekts. Ich verwende Excel 2010 unter Windows 7 Enterprise.

Dankbar für jede Hilfe. Auch Lösungen zur bedingten Anwendung von Funktionen auf Bereiche, die davon stark abweichen, werden gut aufgenommen.

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

Ich mag es nicht mit VBA, wenn eine Excel-Formel effizient genutzt werden kann.

Zunächst einmal können Sie ein Minimum oder Maximum erhalten Bedingungen nach einer einfachen IF in einer Matrixformel mit (geben Sie die Formel Strg + Umschalt + ein. Dadurch wird die umgebenden {}, die ein angeben hinzufügen Matrixformel):

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

diese Formel prüft in A für den Zustand in D1 und gibt den entsprechenden Wert von B. Beachten Sie, dass Ihre Daten brauchen nicht einmal bestellt werden für diese Formel zu arbeiten:

Zweitens, wenn Sie die ersten und letzten Zeilennummern erhalten möchten, können Sie diese Formel mit einem kleinen Zusatz verwenden. Allerdings, ich vermute, dass man die INDIRECT oder OFFSET Funktionen mit diesen Werten verwenden würde, was unnötig und ineffizient ist, da diese Funktionen flüchtig sind. Unabhängig davon ist die Addition zur Formel die ROW Funktion. (Diese Formel benötigt natürlich die Daten, die bestellt werden müssen). Array Formel für Zeilennummern:

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

Dies wird die letzte Zeilennummer für Bananen zurück.

Answer 2

Indem Sie SearchDirection auf xlPrevious einstellen, können Sie ganz einfach das letzte Vorkommen in einem Bereich finden.
Das Umschalten von Application.ScreenUpdating hat wenig Auswirkungen, wenn Sie nur Werte lesen. Ich bevorzuge kürzere Variablennamen. Längere Namen neigen dazu, den Bildschirm zu überladen und es schwieriger zu sehen, was vor sich geht. Aber das ist nur meine Meinung.

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

Meine Antwort ist ähnlich der VBA UDF Lösung zuvor von Thomas Inzina mit ein paar Unterschiede geschrieben.

Der Parameter After:= wird verwendet, um sicherzustellen, dass das erste gefundene Match das erste Match in diesem Bereich ist. Die Range.Find method verwendet eine "Dose-Dose" Ansatz, wo es durch die Zellen der Reichweite Schleifen und startet am Anfang neu, wenn es das Ende erreicht. Wenn Sie After:=.Cells(.Cells.Count) starten und sich vorwärts bewegen, finden Sie die erste Zelle in dem entsprechenden Bereich. Ähnlich, indem Sie bei After:=.Cells(1) beginnen und SearchDirection:=xlPrevious verschieben, finden Sie schnell das Letzte ohne Schleife.

Ich habe auch die Intersect method zu a) verwendet, um vollständige Spaltenreferenzen auf die Worksheet.UsedRange property zu reduzieren und b) um den Arbeitsbereich schnell aus dem festgelegten Kriterienbereich zurückzukehren.

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