If all you want is the weighted rank ( 1 - 7 in your example) something like this maybe?
I did 1000 cases, and counted the number of each rank (1 - 7)
Option Explicit
Function WeightedRank(Rank_Price As Range) As Long
Dim iRow As Long, iHowMany As Long
Dim rData As Range
Dim aImpliedProbability() As Double, aReversed() As Double
Dim dSum As Double, dRandom As Double
Application.Volatile
Set rData = Intersect(Rank_Price, Rank_Price.Parent.UsedRange)
'iHowMany includes header row
For iHowMany = 2 To rData.Rows.Count
If Len(rData.Cells(iHowMany, 2).Value) = 0 Then Exit For
Next iHowMany
iHowMany = iHowMany - 1
ReDim aImpliedProbability(1 To iHowMany)
ReDim aReversed(1 To iHowMany)
'calc implied probability
For iRow = LBound(aImpliedProbability) + 1 To UBound(aImpliedProbability)
aImpliedProbability(iRow) = 1# / rData.Cells(iRow, 2).Value
Next iRow
'reverse order
For iRow = LBound(aImpliedProbability) + 1 To UBound(aImpliedProbability)
aReversed(iHowMany - iRow + 2) = aImpliedProbability(iRow)
Next iRow
'normalize to 1.0
dSum = Application.WorksheetFunction.Sum(aReversed)
For iRow = LBound(aReversed) To UBound(aReversed)
aReversed(iRow) = aReversed(iRow) / dSum
Next iRow
'weight
For iRow = LBound(aReversed) + 1 To UBound(aReversed)
aReversed(iRow) = aReversed(iRow - 1) + aReversed(iRow)
Next iRow
dRandom = Rnd
For iRow = LBound(aReversed) + 1 To UBound(aReversed)
If (aReversed(iRow - 1) < dRandom) And (dRandom <= aReversed(iRow)) Then
WeightedRank = iRow - 1
Exit Function
End If
Next iRow
WeightedRank = 0
End Function