将自定义功能复制到其他单元格(更改活动单元格)

时间:2014-08-21 12:06:28

标签: excel vba excel-vba

当我复制多个单元格时,我试图让这个自定义函数工作。该函数应填充两个数字之间的单元格,并增加衬垫。

Function HINT(FirstCell, LastCell)

x = FirstCell.Column
y = LastCell.Column
a = FirstCell
b = LastCell
step = (b - a) / Abs(x - y)
Actcellc = ActiveCell.Column
HINT = FirstCell + (Actcellc - x) * step
End Function

如果我将它一个一个地复制到第一个单元格和最后一个单元格之间的每个单元格,但是如果我只选择其间的范围并复制则不起作用(只是计算每个单元格中的相同数字,因为它仍然看到活动状态)细胞作为复制的起源。如果我逐个复制,活动细胞会改变并且功能正常工作)。我可以理解我需要将activecell定义更改为另一个东西,但我不知道是什么。

提前致谢。

编辑:

我会在别人的帮助下回答我自己的问题:

Function HINT(FirstCell, LastCell, pos As Range)

Dim i As Long
Dim res() As Double
Dim rng As Range

x = FirstCell.Column
y = LastCell.Column
a = FirstCell
b = LastCell
step = (b - a) / Abs(x - y)

HINT = FirstCell + (pos.Column - x) * step

End Function

在第一个空白单元格(在本例中为C2)中,代码应如下输入: =提示($ B $ 2,$ N $ 2,C2)

$ B $ 2第一个值,固定/ $ N $ 2最后一个值,固定/ C2为位置,第一个空白单元填充。

谢谢大家。

2 个答案:

答案 0 :(得分:1)

尝试使用数组函数:

Function HINT2(FirstCell, LastCell)

    Dim i As Long
    Dim res() As Double

    x = FirstCell.Column
    y = LastCell.Column
    a = FirstCell
    b = LastCell
    step = (b - a) / Abs(x - y)

    ReDim res(1 To (y - x - 1)) As Double

    For i = 1 To y - x - 1
        res(i) = FirstCell + i * step   
    Next

    HINT2 = res


End Function

要使用它,请选择两个边界之间的所有单元格,在公式栏中输入函数名称和参数,然后按Ctrl + Shift + Enter

或者,您可以选择提供“'参数,它将返回单个值并允许轻松复制到多个单元格:

Function HINT3(FirstCell, LastCell, pos As Long)

    Dim i As Long
    Dim res() As Double

    x = FirstCell.Column
    y = LastCell.Column
    a = FirstCell
    b = LastCell
    step = (b - a) / Abs(x - y)

    HINT3 = FirstCell + pos * step

End Function

你可能想要拥有这样的位置'数字1..n连续超出此公式 - 与此类似:

enter image description here

另外,强烈建议声明变量。

答案 1 :(得分:0)

您正在尝试填写多个单元格。您需要一个返回数组的函数或一个 Sub

这是子方法。假设我们要填写 A1 M1

之间的单元格

before

这个小宏:

Sub FillMissingInRow()
    Dim r As Range, v1 As Double, v2 As Double, inc As Double
    Set r = Range("A1:M1")
    v1 = r(1)
    v2 = r(r.Count)
    inc = (v2 - v1) / (r.Count - 1)
    r.DataSeries Rowcol:=xlRows, Type:=xlLinear, Step:=inc, Trend:=False
End Sub

将导致:

after