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 Sub

Bonjour,

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 :

abc

b'

140013981.03
145014101.03
150014281.035
155014761.037
160015121.04
15381.04
16001.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 Sub

Bonjour,

Je vous remercie grandement pour votre aide

Bonne journée

Rechercher des sujets similaires à "interpolation lineaire code vba"