Sub IntersectionDroiteCourbe()
Dim x1 As Double, y1 As Double, x2 As Double, y2 As Double
Dim i As Integer
Dim xCourbe1 As Double, yCourbe1 As Double, xCourbe2 As Double, yCourbe2 As
Double
Dim xIntersection As Double, yIntersection As Double
Dim trouve As Boolean
' Coordonnées des points de la droite
x1 = Range("A20").Value
y1 = Range("B20").Value
x2 = Range("A21").Value
y2 = Range("B21").Value
' Plage des points de la courbe
For i = 4 To 18 ' On parcourt les points de la courbe (A4:A19 et B4:B19)
xCourbe1 = Cells(i, 1).Value
yCourbe1 = Cells(i, 2).Value
xCourbe2 = Cells(i + 1, 1).Value
yCourbe2 = Cells(i + 1, 2).Value
' Vérification si la droite et le segment de la courbe se croisent
If (yCourbe1 - y1) * (yCourbe2 - y2) <= 0 Then
' Calcul de l'intersection par interpolation linéaire
Dim mDroite As Double, pDroite As Double
Dim mCourbe As Double, pCourbe As Double
' Équation de la droite : y = mDroite * x + pDroite
mDroite = (y2 - y1) / (x2 - x1)
pDroite = y1 - mDroite * x1
' Équation du segment de la courbe : y = mCourbe * x + pCourbe
mCourbe = (yCourbe2 - yCourbe1) / (xCourbe2 - xCourbe1)
pCourbe = yCourbe1 - mCourbe * xCourbe1
' Résolution de l'équation mDroite * x + pDroite = mCourbe * x +
pCourbe
xIntersection = (pCourbe - pDroite) / (mDroite - mCourbe)
yIntersection = mDroite * xIntersection + pDroite
' Vérifier si l'intersection est dans les limites du segment de la
courbe
If xIntersection >= xCourbe1 And xIntersection <= xCourbe2 Then
trouve = True
Exit For
End If
End If
Next i
' Résultats
If trouve Then
Range("E23").Value = xIntersection
Range("F23").Value = yIntersection
Else
Range("E23").Value = "Pas d'intersection"
Range("F23").Value = ""
End If
End Sub
Sub IntersectionDroiteCourbe()
Dim x1 As Double, y1 As Double, x2 As Double, y2 As Double
Dim i As Integer
Dim xCourbe1 As Double, yCourbe1 As Double, xCourbe2 As Double, yCourbe2 As
Double
Dim xIntersection As Double, yIntersection As Double
Dim trouve As Boolean
' Coordonnées des points de la droite
x1 = Range("A20").Value
y1 = Range("B20").Value
x2 = Range("A21").Value
y2 = Range("B21").Value
' Plage des points de la courbe
For i = 4 To 17 ' On parcourt les points de la courbe (A4:A19 et B4:B19)
' Vérification que les cellules contiennent bien des nombres
If IsNumeric(Cells(i, 1).Value) And IsNumeric(Cells(i, 2).Value) And _
IsNumeric(Cells(i + 1, 1).Value) And IsNumeric(Cells(i + 1, 2).Value)
Then
xCourbe1 = Cells(i, 1).Value
yCourbe1 = Cells(i, 2).Value
xCourbe2 = Cells(i + 1, 1).Value
yCourbe2 = Cells(i + 1, 2).Value
' Vérification si la droite et le segment de la courbe se croisent
If (yCourbe1 - y1) * (yCourbe2 - y2) <= 0 Then
' Calcul de l'intersection par interpolation linéaire
Dim mDroite As Double, pDroite As Double
Dim mCourbe As Double, pCourbe As Double
' Équation de la droite : y = mDroite * x + pDroite
mDroite = (y2 - y1) / (x2 - x1)
pDroite = y1 - mDroite * x1
' Équation du segment de la courbe : y = mCourbe * x + pCourbe
mCourbe = (yCourbe2 - yCourbe1) / (xCourbe2 - xCourbe1)
pCourbe = yCourbe1 - mCourbe * xCourbe1
' Résolution de l'équation mDroite * x + pDroite = mCourbe * x +
pCourbe
xIntersection = (pCourbe - pDroite) / (mDroite - mCourbe)
yIntersection = mDroite * xIntersection + pDroite
' Vérifier si l'intersection est dans les limites du segment de la
courbe
If xIntersection >= xCourbe1 And xIntersection <= xCourbe2 Then
trouve = True
Exit For
End If
End If
End If
Next i
' Résultats
If trouve Then
Range("E23").Value = xIntersection
Range("F23").Value = yIntersection
Else
Range("E23").Value = "Pas d'intersection"
Range("F23").Value = ""
End If
End Sub
Sub IntersectionsDroitesCourbes()
' Déclaration des variables
Dim x1 As Double, y1 As Double, x2 As Double, y2 As Double
Dim x3 As Double, y3 As Double, x4 As Double, y4 As Double
Dim i As Integer
Dim xCourbe1 As Double, yCourbe1 As Double, xCourbe2 As Double, yCourbe2 As
Double
Dim xIntersection As Double, yIntersection As Double
Dim trouve As Boolean
' Droite 1 : Points
x1 = Range("A20").Value
y1 = Range("B20").Value
x2 = Range("A21").Value
y2 = Range("B21").Value
' Droite 2 : Points
x3 = Range("A22").Value
y3 = Range("B22").Value
x4 = Range("A23").Value
y4 = Range("B23").Value
' Fonction pour trouver l'intersection
' Intersection de la droite 1 avec la courbe 1
Call IntersectionDroiteCourbe(x1, y1, x2, y2, "A4:A19", "B4:B19", "E23", "F23")
' Intersection de la droite 1 avec la courbe 2
Call IntersectionDroiteCourbe(x1, y1, x2, y2, "A4:A19", "C4:C19", "E24", "F24")
' Intersection de la droite 2 avec la courbe 2
Call IntersectionDroiteCourbe(x3, y3, x4, y4, "A4:A19", "C4:C19", "E25", "F25")
' Intersection de la droite 2 avec la courbe 3
Call IntersectionDroiteCourbe(x3, y3, x4, y4, "A3:A19", "B3:B19", "E26", "F26")
End Sub
Sub IntersectionDroiteCourbe(ByVal x1 As Double, ByVal y1 As Double, ByVal x2 As
Double, ByVal y2 As Double, ByVal xRange As String, ByVal yRange As String, ByVal
xResultCell As String, ByVal yResultCell As String)
Dim i As Integer
Dim xCourbe1 As Double, yCourbe1 As Double, xCourbe2 As Double, yCourbe2 As
Double
Dim xIntersection As Double, yIntersection As Double
Dim trouve As Boolean
' Parcourir les points de la courbe
For i = 1 To Range(xRange).[Link] - 1
' Vérification que les cellules contiennent bien des nombres
If IsNumeric(Range(xRange).Cells(i, 1).Value) And
IsNumeric(Range(yRange).Cells(i, 1).Value) And _
IsNumeric(Range(xRange).Cells(i + 1, 1).Value) And
IsNumeric(Range(yRange).Cells(i + 1, 1).Value) Then
xCourbe1 = Range(xRange).Cells(i, 1).Value
yCourbe1 = Range(yRange).Cells(i, 1).Value
xCourbe2 = Range(xRange).Cells(i + 1, 1).Value
yCourbe2 = Range(yRange).Cells(i + 1, 1).Value
' Vérification si la droite et le segment de la courbe se croisent
If (yCourbe1 - y1) * (yCourbe2 - y2) <= 0 Then
' Calcul de l'intersection par interpolation linéaire
Dim mDroite As Double, pDroite As Double
Dim mCourbe As Double, pCourbe As Double
' Équation de la droite : y = mDroite * x + pDroite
mDroite = (y2 - y1) / (x2 - x1)
pDroite = y1 - mDroite * x1
' Équation du segment de la courbe : y = mCourbe * x + pCourbe
mCourbe = (yCourbe2 - yCourbe1) / (xCourbe2 - xCourbe1)
pCourbe = yCourbe1 - mCourbe * xCourbe1
' Résolution de l'équation mDroite * x + pDroite = mCourbe * x +
pCourbe
xIntersection = (pCourbe - pDroite) / (mDroite - mCourbe)
yIntersection = mDroite * xIntersection + pDroite
' Vérifier si l'intersection est dans les limites du segment de la
courbe
If xIntersection >= xCourbe1 And xIntersection <= xCourbe2 Then
trouve = True
Exit For
End If
End If
End If
Next i
' Résultats
If trouve Then
Range(xResultCell).Value = xIntersection
Range(yResultCell).Value = yIntersection
Else
Range(xResultCell).Value = "Pas d'intersection"
Range(yResultCell).Value = ""
End If
End Sub