在 vba 中修改一个名为 LINTERP 的（用户创建的）函数

Question

TL;DR: 下面有两个函数。它们执行相同的任务，但顶部的应该接受范围的起点和计数，而不是需要固定范围的底部的。问题是除非数据放在同一个 sheet 中，否则 top 函数不起作用。这很烦人，更何况我不明白为什么。

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

我决定修改公式，使其不使用严格的 "range" 对象，而是给出一个开始 "cell"（范围），然后是范围维度的计数整数。

我的数据现在必须与计算相同sheet，否则将无法工作。你能看看这是为什么吗？

我的功能（我在我更改的行上标记了一个|）

| Function LINTERPX(x As Double, rXs As Range, rYs As Range, No As Integer) As Variant
| With ThisWorkbook

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

   | Set rX = Range(Cells(rXs.Row, rXs.Column), Cells(rXs.Row + No - 1, rXs.Column))
   | Set rY = Range(Cells(rYs.Row, rYs.Column), Cells(rYs.Row + No - 1, rYs.Column))
| End With
  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)

LINTERPX = rY(i).Value2 * (1 - dF) + rY(i + 1).Value2 * dF
Exit Function

Oops:
LINTERPX = CVErr(xlErrValue)
End Function

原文：

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

Answer 1

这解决了我的问题：

Set rX = and Set rY lines are probably causing the problem. Range refers to active sheet. Please try Set rX = rXs.Resize(No , 1) instead (similar for rY) – user3964075 50 mins ago

谢谢用户3964075！

在 vba 中修改一个名为 LINTERP 的（用户创建的）函数

Modding a (user made) function in vba called LINTERP

vba

function

excel

with-statement