Excel Interpolation Linéaire VBA

cette fonction à interpoler/extrapole une table de x,y
Par exemple,

x y
1 10
2 15
3 20

Linterp(A1:B3, -1) = 0

Toutefois, ce code ne peut le faire à deux adjacents tableaux.
Je voudrais modifier ce code afin que je puisse
sélectionnez deux tableaux distincts, par exemple N106:N109,P106:P109.
Comment puis-je faire ce réglage dans ce code?

Function Linterp(r As Range, x As Double) As Double
     ' linear interpolator /extrapolator
     ' R is a two-column range containing known x, known y
    Dim lR As Long, l1 As Long, l2 As Long
    Dim nR As Long
     'If x = 1.5 Then Stop

    nR = r.Rows.Count
    If nR < 2 Then Exit Function

    If x < r(1, 1) Then ' x < xmin, extrapolate
        l1 = 1: l2 = 2: GoTo Interp

    ElseIf x > r(nR, 1) Then ' x > xmax, extrapolate
        l1 = nR - 1: l2 = nR: GoTo Interp

    Else
         ' a binary search would be better here
        For lR = 1 To nR
            If r(lR, 1) = x Then ' x is exact from table
                Linterp = r(lR, 2)
                Exit Function

            ElseIf r(lR, 1) > x Then ' x is between tabulated values, interpolate
                l1 = lR: l2 = lR - 1: GoTo Interp

            End If
        Next
    End If

Interp:
    Linterp = r(l1, 2) _
    + (r(l2, 2) - r(l1, 2)) _
    * (x - r(l1, 1)) _
    / (r(l2, 1) - r(l1, 1))

End Function
  • Si une plage discontinue est passée, vous pouvez détecter que l'utilisation de r.Areas.Count
  • Désolé mais je suis nouveau sur VBA. qu'est-r.Les zones.Le comte exactement?
InformationsquelleAutor AccessExcelVBA | 2016-04-06
  1. 5

    un moyen très simple est d'avoir la fonction de l'acceptation des deux plages dans l'entrée, un pour les valeurs de X (dire rX) et Y (à dire rY), et puis changer chaque occurrence de r(foo,1) à rX(foo) et r(foo,2) à rY(foo)

    comme suit

    Option Explicit

Function Linterp2(rX As Range, rY As Range, x As Double) As Double
     ' linear interpolator /extrapolator
     ' R is a two-column range containing known x, known y
    Dim lR As Long, l1 As Long, l2 As Long
    Dim nR As Long
     'If x = 1.5 Then Stop

    nR = rX.Rows.Count
    If nR < 2 Then Exit Function

    If x < rX(1) Then ' x < xmin, extrapolate
        l1 = 1: l2 = 2: GoTo Interp

    ElseIf x > rX(nR) Then ' x > xmax, extrapolate
        l1 = nR - 1: l2 = nR: GoTo Interp

    Else
         ' a binary search would be better here
        For lR = 1 To nR
            If rX(lR) = x Then ' x is exact from table
                Linterp2 = rY(lR)
                Exit Function

            ElseIf rX(lR) > x Then ' x is between tabulated values, interpolate
                l1 = lR: l2 = lR - 1: GoTo Interp

            End If
        Next
    End If

Interp:
    Linterp2 = rY(l1) _
    + (rY(l2) - rY(l1)) _
    * (x - rX(l1)) _
    / (rX(l2) - rX(l1))

End Function

    mais vous devez implémenter le code de vérification de la cohérence des deux gammes, comme étant à la fois d'une colonne de chacun et avec le même nombre de lignes

    • Pour info, cette fonction nécessite le x-range (xR) à trier du plus petit au plus grand
    InformationsquelleAutor user3598756