Option Explicit
Public Function QuantileFind(ByVal q As Double) As Variant
Dim i&, j&, m&
With Worksheets("Tabelle1")
With .Range("A2", .Cells(.Rows.Count, "A").End(xlUp))
If .Row < 2 Then
QuantileFind = Empty
Exit Function
End If
i = 1
j = .Count
Do While i < j
m = (i + j) \ 2
If q > .Cells(m, 1).Value Then
j = m - 1
ElseIf q < .Cells(m, 1).Value Then
i = m + 1
Else
QuantileFind = .Cells(m, 1).Offset(0, 1).Value
Exit Function
End If
Loop
QuantileFind = .Cells(WorksheetFunction.Max(i, j)).Offset(0, 1).Value
End With
End With
End Function