Interpolation linéaire code VBA
Option Explicit
Sub inter()
Dim cell As Range
Dim Prof
Dim xi#, yi#
Dim x1, x2, y1, y2
Sheets("Feuil2").Select
Prof = Range("G2:G1062")
yi = Range("E2:E181")
For Each cell In Sheets("Feuil2").Range("H2:H1062")
If (cell.Value) < yi < (cell.Value) + 1 Then
x1 = cell.Offset(1, 0) 'Prend la valeur x juste inférieure à la valeur recherchée
y1 = cell.Offset(Prof, 0) 'Prend la valeur de la profondeur associée
x2 = cell.Offset(2, 0) 'Prend la valeur supérieure à la valeur recherchée
y2 = cell.Offset(Prof + 1, 0)
End If
Next
xi = x1 + (x2 - x1) * ((yi - y1) / (y2 - y1))
Sheets("Feuil2").Select
Range("F2:F181") = xi
End SubBonjour,
Je souhaiterais écrire un code vba afin de faire une interpolation "linéaire" mais j'arrive pas à savoir comment m'en sortir... Je vous explique, j'ai une feuille avec des données :
| a | b | c | b' | |
| 1400 | 1398 | 1.03 | ||
| 1450 | 1410 | 1.03 | ||
| 1500 | 1428 | 1.035 | ||
| 1550 | 1476 | 1.037 | ||
| 1600 | 1512 | 1.04 | ||
| 1538 | 1.04 | |||
| 1600 | 1.05 |
Ma colonne c représente les données que j'ai et la b' les valeurs associées à la colonne c. Ma colonne a représente les valeurs que je voudrais avoir et b les valeurs associées à a en interpolant b'... Ici pour avoir ma valeur de b pour 1400, il faudrait que j'interpole entre 1398 et 1410 (et ainsi de suite pour 1450, 1500 etc)... Comme vous pourrez le constater, mon nombre de lignes dans ma colonne c n'est pas la même que dans ma colonne a... Je vous mets le code que j'ai commencé à écrire...
Merci pour votre aide.
bonjour,
de ce que j'ai compris,
Sub aargh()
With Sheet1
dla = .Cells(Rows.Count, 1).End(xlUp).Row 'dernière ligne colonne A
dlb = .Cells(Rows.Count, 4).End(xlUp).Row 'dernière ligne colonne D
For i = 2 To dla 'prend une à une les valeurs en colonne A
v = .Cells(i, 1) ' a
For j = 2 To dlb 'recherche l'intervalle qui contient a
If v <= .Cells(j, 4) Then
If v = .Cells(j, 4) Then
.Cells(i, 2) = .Cells(j, 5) 'valeur exacte trouvée on copie
Else
x1 = .Cells(j - 1, 4) 'intervalle trouvé on calcule
y1 = .Cells(j - 1, 5)
x2 = .Cells(j, 4)
y2 = .Cells(j, 5)
.Cells(i, 2) = y1 + (v - x1) * (y2 - y1) / (x2 - x1)
End If
Exit For ' on a trouvé l'intervalle on sort de la boucle
End If
Next j
Next i
End With
End SubBonjour,
Je vous remercie grandement pour votre aide
Bonne journée