在vba中修改名为LINTERP的（用户自制）函数

TL；DR：下面有两个功能。它们执行相同的任务，但是最上面的任务应该接受范围和计数的起点，而不是需要固定范围的底部任务。问题是，除非数据放在同一张表中，否则top函数不起作用。这很烦人，我不明白为什么会这样。

当我发现有人为excel制作了一个不错的插值器时，我松了一口气，因为他们只能在2个点之间绘制趋势，这还不足以适合我的测量

我决定修改公式，使其不使用刚性的“范围”对象，而是提供一个起始“单元格”（范围），然后是范围维度的计数整数

我的数据现在必须与计算结果在同一张表上，否则它将不起作用。你能看看为什么会这样吗

我的函数（我已在已更改的行上标记a |）

|函数LINTERPX（x为双精度，rXs为范围，rYs为范围，No为整数）作为变量
|使用此工作簿
将i作为“长”索引变为rY
Dim dF作为双插值分数
尺寸v作为每个/回路控制变量的变量
|变暗接收范围
|暗淡如射程
|设置rX=范围（单元格（rXs.Row，rXs.Column），单元格（rXs.Row+No-1，rXs.Column））
|设置rY=范围（单元格（rYs.Row，rYs.Column），单元格（rYs.Row+No-1，rYs.Column））
|以
对于阵列中的每个v（rX，rY）
如果v.Areas.Count>1，则转到Oops
如果v.Rows.Count 1和v.Columns.Count 1，则转到Oops
如果工作表function.Count（v）v.Count，则转到Oops
下一个v
如果rX.Count小于2，则转到Oops
如果rX.Count rY.Count，则转到Oops
dFrac x，rX，i，dF，IIf（rX（2）.值2>rX（1）.值2，1，-1）
LINTERPX=rY（i）.值2*（1-dF）+rY（i+1）.值2*dF
退出功能
哎呀：
LINTERPX=CVErr（Xlerr值）
端函数

原件：

Function LINTERP(x As Double, rX As Range, rY As Range) As Variant

' shg 1997-0606, 2009-0419
'     2009-0604 added option for descending sort

' Linear interpolator / extrapolator
' Interpolates rX to return the value of y corresponding to the given x

' rX and rY must be equal-length vectors
' rX must be sorted (ascending or descending, doesn't matter)

Dim i       As Long     ' index to rY
Dim dF      As Double   ' interpolation fraction
Dim v       As Variant  ' for each/loop control variable

For Each v In Array(rX, rY)
    If v.Areas.Count > 1 Then GoTo Oops
    If v.Rows.Count <> 1 And v.Columns.Count <> 1 Then GoTo Oops
    If WorksheetFunction.Count(v) <> v.Count Then GoTo Oops
Next v
If rX.Count < 2 Then GoTo Oops
If rX.Count <> rY.Count Then GoTo Oops

dFrac x, rX, i, dF, IIf(rX(2).Value2 > rX(1).Value2, 1, -1)
LINTERP = rY(i).Value2 * (1 - dF) + rY(i + 1).Value2 * dF
Exit Function

Oops:
LINTERP = CVErr(xlErrValue)
End Function

功能LINTERP（x为双精度，rX为量程，rY为量程）作为变量
‘shg 1997-06062009-0419
'2009-0604添加了降序排序选项
'线性插值器/外推器
'内插rX以返回与给定x对应的y值
'rX和rY必须是等长向量
必须对rX进行排序（升序或降序，无所谓）
将i作为“长”索引变为rY
Dim dF作为双插值分数
尺寸v作为每个/回路控制变量的变量
对于阵列中的每个v（rX，rY）
如果v.Areas.Count>1，则转到Oops
如果v.Rows.Count 1和v.Columns.Count 1，则转到Oops
如果工作表function.Count（v）v.Count，则转到Oops
下一个v
如果rX.Count小于2，则转到Oops
如果rX.Count rY.Count，则转到Oops
dFrac x，rX，i，dF，IIf（rX（2）.值2>rX（1）.值2，1，-1）
LINTERP=rY（i）.Value2*（1-dF）+rY（i+1）.Value2*dF
退出功能
哎呀：
LINTERP=CVErr（Xlerr值）
端函数

这解决了我的问题：

Set rX=和Set rY线路可能是导致问题的原因。范围是指活动工作表。请尝试设置rX=rXs。改为调整大小（否，1）（与rY类似）–50分钟前的用户3964075

---

谢谢你，用户3964075

不清楚你在问什么。太多的信息。你应该减少你的职位，只保留基本的东西。这将增加你获得帮助的机会。有关指导信息，请参阅：

Set rX=

和

Set rY

行可能是导致问题的原因<代码>范围指激活的工作表。请尝试

Set rX=rXs.Resize（No，1）

（类似于

rY

）@Jean-FrançoisCorbett:我添加了一个TL；上面的博士，这涵盖了它吗？它几乎涵盖了，所以为什么不删除所有不必要的部分呢。StackOverflow作为一个社区，它喜欢简洁，而不是冗长的博客文章。Gotcha=）@pnuts我假设当一个函数的输入是一个范围时，它会接受另一个工作表上的范围。i、 e.第1页！e13或e13都应该工作。不

Function LINTERP(x As Double, rX As Range, rY As Range) As Variant

' shg 1997-0606, 2009-0419
'     2009-0604 added option for descending sort

' Linear interpolator / extrapolator
' Interpolates rX to return the value of y corresponding to the given x

' rX and rY must be equal-length vectors
' rX must be sorted (ascending or descending, doesn't matter)

Dim i       As Long     ' index to rY
Dim dF      As Double   ' interpolation fraction
Dim v       As Variant  ' for each/loop control variable

For Each v In Array(rX, rY)
    If v.Areas.Count > 1 Then GoTo Oops
    If v.Rows.Count <> 1 And v.Columns.Count <> 1 Then GoTo Oops
    If WorksheetFunction.Count(v) <> v.Count Then GoTo Oops
Next v
If rX.Count < 2 Then GoTo Oops
If rX.Count <> rY.Count Then GoTo Oops

dFrac x, rX, i, dF, IIf(rX(2).Value2 > rX(1).Value2, 1, -1)
LINTERP = rY(i).Value2 * (1 - dF) + rY(i + 1).Value2 * dF
Exit Function

Oops:
LINTERP = CVErr(xlErrValue)
End Function