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!
|