Excel条件线性插值

我想建立一个条件线性插值。我有超过31个唯一标识符。其中范围根据其选择的标识符进行更改。我想我可以根据案例标准进行选择，但这似乎不是最有效的

数据如下所示。（其中货币是标识符）

AED 14

AED 2 6

澳元11

AED 3 12

澳元2 6

AED 4 13

澳元38

---

下面是原始的线性插值公式（无任何条件）。有什么好办法解决这个问题吗

 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

功能Linterp2（rX为量程，rY为量程，x为双精度）为双精度
'线性插值器/外推器
'R是包含已知x和已知y的两列范围
变暗lR变长，l1变长，l2变长
暗nR与长nR相同
'如果x=1.5，则停止
nR=rX.Rows.Count
如果nR<2，则退出功能
如果xrX（nR），然后'x>xmax，外推
l1=nR-1:l2=nR:GoTo Interp
其他的
“在这里进行二进制搜索会更好
对于lR=1至nR
如果rX（lR）=x，则“x”与表中的值精确
过梁2=rY（lR）
退出功能
ElseIf rX（lR）>x则‘x在列表值之间，插值
l1=lR:l2=lR-1:GoTo Interp
如果结束
下一个
如果结束
内部程序：
过梁2=rY（l1）_
+（rY（l2）-rY（l1））_
*（x-rX（l1））_
/（接收（l2）-接收（l1））
端函数

mmm“你想建立一个条件线性插值”并说“假设ID是AED”让我推测一下你真正想要什么

首先你有一个函数（做线性插值）

其次，为了便于解释，您有一个包含3列的表：

第1列：ID（标识将使用哪些范围的值）

第2列：变量为X的值的数量（范围X）

第2列：具有变量Y的值的数量（范围Y）

这意味着，如果选择ID=AED，函数（）将取range.size表示X，range.size表示Y（例如，您编写的第一行仅取AED）

1：如果是这种情况，您希望在函数中选择“select case”：

*首先，选择范围的所有列（选择范围X的所有列2，选择范围y的所有列3）和X值

*然后当你的函数运行时；函数必须识别ID（您想知道）并调整范围X、Y的大小，并且只接受ID为的值，如identify

所以你需要改变函数中的变量，因为你需要在每个点的ID，X值和y值之间建立一个强制性的关系。 所以我们需要一个矩阵

Function Linterp2(Mtr As Range, x As Double, ID as String) As Double

在这种情况下，您的范围有3列和n行（需要选择所有表） 然后在搜索范围内的ID时执行“For”

    dim MtrP(0,2)
 for i=1 to mtr.rows.count
    if MtrP(0,0)=nothing then  /*get first value*/
       if Mtr.cells(i,1).value="ID" then
        MtrP(0,0)=Mtr.cells(i,1)
        MtrP(0,1)=Mtr.cells(i,1)
        MtrP(0,2)=Mtr.cells(i,1)
        j=0
       end if
    elseif Mtr.cells(i,1).value="ID" then
        j=j+1
        redim preserve MtrP(j,2)
        MtrP(j,0)=Mtr.cells(i,1)
        MtrP(j,1)=Mtr.cells(i,1)
        MtrP(j,2)=Mtr.cells(i,1)
    end if
next

此时，您需要的所有数据的新阵列都是MtrP，您可以使用它进行线性插值， 请注意，数组的索引为0，而范围的索引为1

Function Linterp3(rX As Range, rY As Range, rID As Range, x As Double, id As String) As Double
    ' Linear interpolator / extrapolator with index criteria
    ' Inputs:
    '        rX - 1 column range of x Values
    '        rY - 1 column range of y Values
    '        rID - 1 column range of index criteria
    '        x - x value criterion
    '        id - index criterion
    
    ' Select the relevant parts of the X,Y ranges based on the id criteria
    Dim rX_selected() As Double, rY_selected() As Double, i As Integer, j As Integer
    j = 0
    
    For i = 1 To rX.Worksheet.UsedRange.Rows.Count
        If rID.Cells(i).Value = id Then

            ReDim Preserve rX_selected(j)
            ReDim Preserve rY_selected(j)

            rX_selected(j) = rX(i).Cells.Value
            rY_selected(j) = rY(i).Cells.Value
            j = j + 1
        End If
    Next
        
    'Linearly interpolate
    Dim lR As Long, l1 As Long, l2 As Long
    Dim nR As Long
    

    nR = j
    If nR < 2 Then Exit Function

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

    ElseIf x > rX_selected(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 - 1
            If rX_selected(lR) = x Then ' x is exact from table
                Linterp3 = rY_selected(lR)
                Exit Function

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

            End If
        Next
    End If

Interp:
    Linterp3 = rY_selected(l1) _
    + (rY_selected(l2) - rY_selected(l1)) _
    * (x - rX_selected(l1)) _
    / (rY_selected(l2) - rX_selected(l1))
        
End Function

函数Linterp3（rX为范围，rY为范围，rID为范围，x为双精度，id为字符串）为双精度
'带索引标准的线性插值器/外推器
“投入：
'rX-x值的1列范围
'rY-y值的1列范围
'rID-索引条件的1列范围
'x-x值标准
“id-索引标准”
'根据id标准选择X、Y范围的相关部分
Dim rX_selected（）为双精度，rY_selected（）为双精度，i为整数，j为整数
j=0
对于i=1到rX.Worksheet.UsedRange.Rows.Count
如果rID.Cells（i）.Value=id，则
已选择重拨保留接收（j）
已选择的重拨保留Y_（j）
选择的rX_（j）=rX（i）.单元格值
所选rY_（j）=rY（i）.Cells.Value
j=j+1
如果结束
下一个
'线性插值
变暗lR变长，l1变长，l2变长
暗nR与长nR相同
nR=j
如果nR<2，则退出功能
如果选择了xrX_选择（nR-1），然后'x>xmax，外推
l1=nR-1:l2=nR:GoTo Interp
其他的
“在这里进行二进制搜索会更好
对于lR=1至nR-1
如果选择了rX_（lR）=x，则“x”与表中的值完全相同
Linterp3=所选的Y_（lR）
退出功能
ElseIf rX_selected（lR）>x然后‘x在列表值之间，插值
l1=lR:l2=lR-1:GoTo Interp
如果结束
下一个
如果结束
内部程序：
Linterp3=所选的Y_（l1）_
+（Y_选择（l2）-Y_选择（l1））_
*（x-选择的rX_（l1））_
/（rY_选择（l2）-rX_选择（l1））
端函数

您想做什么？对于给定的数据，您的输出是什么？我正在尝试线性插值。假设ID为AED（即仅具有此条件的线性插值）。第2列是我的x范围，第3列是我的y范围。例如，AED x=2.5的线性插值。结果是9。