Un petit exemple. Dans Feuil1 j'ai mis :
A B
1 0 18
2 3 22
3 6 27
4 9 33
5 12 42
6 15 35
7 18 24
8 21 18
9 24 11
10 27 7
Et cette macro en VBA :
Sub Intrapol()
Dim Plage As Range ' plage des étiquettes des abscisses
Dim Rang As Long ' pour renvoyer le rang de la valeur cherchée
Dim Absc_Cherchée As Double ' valeur d'abscisse à rechercher
Dim Absc_Trouvée As Double ' valeur d'abscisse trouvée
Dim Delta As Double ' écart entre l'abscisse cherchée et l'abscisse connue inférieure la plus proche
Dim Ordo_Inf As Double ' ordonnée connue immédiatement inférieure à celle cherchée
Dim Ordo_Sup As Double ' ordonnée connue immédiatement supérieure à celle cherchée
Dim Ecart_Absc As Double ' écart entre les 2 abscisses encadrant la valeur cherchée
Dim Ecart_Ordo As Double ' écart entre les 2 ordonnées encadrant la valeur cherchée
Dim Résultat As Double ' résultat de la requête
'=================
Absc_Cherchée = 7 ' valeur d'abscisse à fournir
'=================
Set Plage = Worksheets("Feuil1").Range("A1:A10")
Rang = Application.WorksheetFunction.Match(Absc_Cherchée, Plage, 1)
Absc_Trouvée = Plage.Cells(Rang).Value
If Absc_Trouvée = Absc_Cherchée Then
MsgBox "Résultat : " & Plage.Cells(Rang).Offset(0, 1).Value
Else
Ecart_Absc = Plage.Cells(Rang + 1).Value - Absc_Trouvée
Ordo_Inf = Plage.Cells(Rang).Offset(0, 1).Value
Ordo_Sup = Plage.Cells(Rang + 1).Offset(0, 1).Value
Ecart_Ordo = Ordo_Sup - Ordo_Inf
Delta = Absc_Cherchée - Absc_Trouvée
Résultat = Ordo_Inf + (Ecart_Ordo * (Delta / Ecart_Absc))
MsgBox "Résultat : " & Résultat
End If
End SubLe graphique donne une petite courbe. Bon.
Si tu demandes une valeur d'abscisse qui figure dans les abscisses connues (p. ex. la valeur 9 en A4), on donne immédiatement le résultat de l'ordonnée : 33.
Si maintenant tu demandes l'abscisse 11, qui ne figure pas, la macro calcule une valeur intermédiaire, en faisant une interpolation linéaire. Résultat ici : 39. C'est mieux que rien ?
Si ça te va, fais les adaptations nécessaires...
Action true/false case a coche excel vba
