Intersección de una recta y una curva con diferente tamaño de series de datos

Hola buenas, quería preguntar si es posible encontrar mediante alguna combinación de formulas de excel o mediante vba los puntos para encontrar la intersección de una serie de datos con 14 valores y otra con 2 valores solamente.

intersección --> (x,y) = (0,6796;0,9776)

x y x y
0 0 0,5 0,5
0,05 0,5228056 0,7 1,1
0,1 0,6981492
0,15 0,786024
0,2 0,8388141
0,3 0,8992054
0,4 0,9327838
0,5 0,9541622
0,6 0,9689673
0,7 0,9798268
0,8 0,9881326
0,9 0,9946906
0,95 0,997478
1 1

Por internet encontré esta función que si que sirve para cuando los rangos son iguales.Me gustaría haberla modificado pero mi nivel de vba no están avanzado.Lo adjunto por si consideran que puede ser útil para una posible resolución final de su respuesta.Agradecería si alguien encontrará una solución porque llevo bastante tiempo intentando y ya no se como resolverlo.

Public Function InterceptsofTwoDataSets(rngX As Range, rngY1 As Range, rngY2 As Range, _
Optional strParam As String = "X")
Dim i As Long
Dim X As Double, _
Y As Double
Dim bolFound As Boolean, _
dbl As Double
Dim m1 As Double, _
m2 As Double, _
c1 As Double, _
c2 As Double
'Check Data Sets
'this version assumes the data is ok
'sort data to make sure it is in X-ascending order
'this version assumes it is
'Loop through and find first intersection
bolFound = False
For i = 1 To rngX.Rows.Count - 1
dbl = (rngY1(i) - rngY2(i)) * (rngY1(i + 1) - rngY2(i + 1))
bolFound = Sgn(dbl) <> 1
If bolFound Then Exit For 'intercept found, a 0 or -1
Next i
If bolFound Then
m1 = Application.Slope(Range(rngY1(i), rngY1(i + 1)), Range(rngX(i), rngX(i + 1)))
c1 = Application.Intercept(Range(rngY1(i), rngY1(i + 1)), Range(rngX(i), rngX(i + 1)))
m2 = Application.Slope(Range(rngY2(i), rngY2(i + 1)), Range(rngX(i), rngX(i + 1)))
c2 = Application.Intercept(Range(rngY2(i), rngY2(i + 1)), Range(rngX(i), rngX(i + 1)))
Y = (c1 * m2 - m1 * c2) / (m2 - m1)
X = (Y - c2) / m2
If (UCase(strParam) = "X") Then
InterceptsofTwoDataSets = X
Else
InterceptsofTwoDataSets = Y
End If
Else
InterceptsofTwoDataSets = "Lines do not intersect"
End If
End Function

Un saludo

Añade tu respuesta

Haz clic para o