Thema Datum  Von Nutzer Rating
Antwort
25.02.2021 21:38:52 Till
NotSolved
26.02.2021 04:23:43 Gast21258
Solved
26.02.2021 10:01:17 Till
NotSolved
26.02.2021 14:54:18 Gast41007
*****
NotSolved
26.02.2021 10:42:13 Till
NotSolved
Blau ;o)
26.02.2021 14:49:46 Gast81181
NotSolved
Rot Nächstgelegener Wert in einer Range suchen
26.02.2021 17:02:58 Till
NotSolved
26.02.2021 17:23:35 Gast68426
NotSolved
27.02.2021 14:16:09 Till
NotSolved
27.02.2021 22:42:32 Gast68426
NotSolved

Ansicht des Beitrags:
Von:
Till
Datum:
26.02.2021 17:02:58
Views:
647
Rating: Antwort:
  Ja
Thema:
Nächstgelegener Wert in einer Range suchen

Da auch bei diesem Code wieder Rundungsfehler aufgetreten sind (wenn nach 0,501 gesucht wurde, nahm er den Wert von 0,51 und umgekehrt nahm er bei 0.989 den wert von 0,98), habe ich nun die Differenzen zu den benachbarten Quantilen gebildet und geprüft welchem er näher ist. Wenn das gesuchte Quantil genau in der Mitte von zwei eingetragenen liegt (also zwei Differenzen haben den selben wert) dann nimmt er immer den nächstgrößeren (da ich optimist bin und bei der Hälfte aufrunde ;) ) Meine Probleme sind nun gelöst! 

Hier noch meine endgültige Funktion:
(Bitte nicht an den ganzen Kommentaren aufhängen. Sind für den Dozenten, bei dem ich es abgeben muss)

Public Function QuantilFinder(q As Double) As Variant
    With Worksheets("Quantile")
        With .Range("A2", .Cells(.Rows.Count, "A").End(xlUp))
            'prüfung ob Quantiltabelle leer ist
            If .Row < 2 Then
                'wenn leer -> Funktion verlassen
                QuantilFinder = Empty
                Exit Function
                End If
                i = 1             'von der ersten Zelle aus
                j = .Count        'von der Letzte beschriebenen Zelle aus
                'i und j Grenzen den Bereich der suche nach q ein
                'Abbruch der suche,wenn i nicht mehr kleiner j
                Do While i < j
                    'Beginn der Prüfung in der Mitte der Tabelle
                    '\ gibt nach der Division nur den ganzzahligen Teil des Ergebnisses
                    m = (i + j) \ 2
                    
                    'q größer als Mitte des Prüfbereiches?
                    If q > .Cells(m, 1).Value Then
                    'Prüfung positiv -> obere Grenze des Bereiches auf eine Zelle unterhalb der Mitte setzen
                    i = m + 1
                        'q kleiner als Mitte des Prüfbereiches?
                        ElseIf q < .Cells(m, 1).Value Then
                            'Prüfung positiv -> untere Grenze des Bereiches auf eine Zelle überhalb der Mitte setzen
                            j = m - 1
                        Else
                            'wenn q gleich der Mitte ist kann das Ergebnis zurückgegeben werden
                            QuantilFinder = .Cells(m, 1).Offset(0, 1).Value
                        Exit Function
                      End If
                Loop
            
            'Prüfung ob der Wert über der ermittelten Zelle den Typ String hat (Kopfzeile)
            If VarType(.Cells(i, 1).Offset(-1, 0).Value) = 8 Then
                'Prüfung positiv -> ersten Eintrag untehalb der Kopfzeile nehmen
                QuantilFinder = .Cells(1, 1).Offset(0, 1).Value
                Exit Function
            'Prüfung ob der Wert unter der ermittelten Zelle ohne Typ ist (ermittelte Zelle = letzter eintrag)
            ElseIf VarType(.Cells(i, 1).Offset(1, 0).Value) = 0 Then
                'Differernz von Alpha zum Wert der ermittelten Zelle und der Zelle darüber bilden
                l1 = Abs(q - .Cells(i, 1).Offset(-1, 0).Value)
                l2 = Abs(q - .Cells(i, 1).Value)
                'prüfen ob Alpha näher am Wert der Zelle darüber ist (oder gleich weit entfernt)
                If l1 < l2 Then
                    'Prüfung positiv -> Quantil der Zelle darüber zurückgeben
                    QuantilFinder = .Cells(i, 1).Offset(-1, 1).Value
                    Exit Function
                Else
                    'Prüfung negativ -> Quantil der ermittelten  Zelle zurückgeben
                    QuantilFinder = .Cells(i, 1).Offset(0, 1).Value
                End If
                Exit Function
            End If
            
            'Differenzen von Alpha zu der ermittelten Zelle sowie der darüber und der darunter bilden
            l1 = Abs(q - .Cells(i, 1).Offset(-1, 0).Value)    'Zelle darüber
            l2 = Abs(q - .Cells(i, 1).Value)                  'ermittelte Zelle
            l3 = Abs(q - .Cells(i, 1).Offset(1, 0).Value)     'Zelle darunter
            
            'Alpha näher oder gleichnah am Wert der oberen Zelle im Vergleich zur ermittelten Zelle?
            '-> Quantil(Alpha) der darüberliegenden Zelle wählen
            If l1 < l2 Then
                QuantilFinder = .Cells(i, 1).Offset(-1, 1).Value
            'Alpha näher an Wert der ermittelten Zelle als an den anderen beiden?
            '-> Quantil(Alpha) der ermittelten Zelle zurückgeben
            'Wenn abstand zwischen ermittelter und darunterliegender Zelle gleich ist -> ermittelte Zelle wählen
            ElseIf l2 <= l1 And l2 < l3 Then
                QuantilFinder = .Cells(i, 1).Offset(0, 1).Value
            'Alpha näher an darunterliegender Zelle als an ermittelter Zelle?
            '-> Quantil(Alpha) der darunterliegenden Zelle wählen
            ElseIf l3 <= l2 Then
                QuantilFinder = .Cells(i, 1).Offset(1, 1).Value
            End If
            
        End With
    End With
End Function

Vielen dank nochmal!

Schönes Wochenende!


Ihre Antwort
  • Bitte beschreiben Sie Ihr Problem möglichst ausführlich. (Wichtige Info z.B.: Office Version, Betriebssystem, Wo genau kommen Sie nicht weiter)
  • Bitte helfen Sie ebenfalls wenn Ihnen geholfen werden konnte und markieren Sie Ihre Anfrage als erledigt (Klick auf Häckchen)
  • Bei Crossposting, entsprechende Links auf andere Forenbeiträge beifügen / nachtragen
  • Codeschnipsel am besten über den Code-Button im Text-Editor einfügen
  • Die Angabe der Emailadresse ist freiwillig und wird nur verwendet, um Sie bei Antworten auf Ihren Beitrag zu benachrichtigen
Thema: Name: Email:



  • Bitte beschreiben Sie Ihr Problem möglichst ausführlich. (Wichtige Info z.B.: Office Version, Betriebssystem, Wo genau kommen Sie nicht weiter)
  • Bitte helfen Sie ebenfalls wenn Ihnen geholfen werden konnte und markieren Sie Ihre Anfrage als erledigt (Klick auf Häckchen)
  • Bei Crossposting, entsprechende Links auf andere Forenbeiträge beifügen / nachtragen
  • Codeschnipsel am besten über den Code-Button im Text-Editor einfügen
  • Die Angabe der Emailadresse ist freiwillig und wird nur verwendet, um Sie bei Antworten auf Ihren Beitrag zu benachrichtigen

Thema Datum  Von Nutzer Rating
Antwort
25.02.2021 21:38:52 Till
NotSolved
26.02.2021 04:23:43 Gast21258
Solved
26.02.2021 10:01:17 Till
NotSolved
26.02.2021 14:54:18 Gast41007
*****
NotSolved
26.02.2021 10:42:13 Till
NotSolved
Blau ;o)
26.02.2021 14:49:46 Gast81181
NotSolved
Rot Nächstgelegener Wert in einer Range suchen
26.02.2021 17:02:58 Till
NotSolved
26.02.2021 17:23:35 Gast68426
NotSolved
27.02.2021 14:16:09 Till
NotSolved
27.02.2021 22:42:32 Gast68426
NotSolved