Question

此函数对已知x，y的表进行插值/外推例如，

Linterp（A1：B3，-1）= 0

但是，此代码只能执行两个相邻的数组。我想修改这段代码以便我可以选择两个单独的数组，例如N106：N109，P106：P109。如何在此代码中进行此调整？

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

Answer 1

一个非常简单的方法是让函数在输入中接受两个范围，一个用于X值（比如rX），一个用于Y个（比如rY），然后将每个出现的r(foo,1)更改为{{1 }和rX(foo)到r(foo,2)

如下

rY(foo)

但是您必须实现代码来检查两个范围的一致性，例如每个范围都是一列并且具有相同的行数

Excel线性插值VBA

1 个答案: