Excel VBA数组函数将向上移动一个向量答案

【问题标题】：Excel VBA Array Function that will shift a Vector upExcel VBA数组函数将向上移动一个向量
【发布时间】：2020-01-02 04:33:35
【问题描述】：

我需要一个数组函数，它将 rng 范围内的向量向上移动 n 个单元格。到目前为止，这是我的代码：

Option Explicit
Option Base 1

Function ShiftVector(rng As Range, n As Integer)
Dim nr As Integer
Dim i As Integer
Dim head() As Variant
Dim tail() As Variant
Dim shift() As Variant

nr = rng.Rows.Count
ReDim head(n)

For i = 1 To n
        head(i) = rng(i).Value
    Next i

ReDim tail(nr - n)

For i = 1 To nr - n
        tail(i) = rng(n + i).Value
    Next i

ReDim shift(nr)

For i = 1 To nr - n
        shift(i) = tail(i)
    Next i

For i = (nr - n + 1) To nr
        shift(i) = head(i - (nr - n))
    Next i

ShiftVector = shift()

End Function

我已测试将其作为子例程运行，并在本地窗口中看到新数组“shift()”具有我需要的值，但是我无法将新数组作为函数输出到新位置，如下所示：

【问题讨论】：

标签： arrays excel vba function

【解决方案1】：

在处理 Ranges 时，最容易使用 2D 数组。此外，您的逻辑可以简化很多。

Function ShiftVector(rng As Range, n As Long)
    Dim i As Long
    Dim shift() As Variant
    Dim dat As Variant

    ReDim shift(1 To rng.Rows.Count, 1 To 1)
    dat = rng.Value 'this will speed up the UDF on larger ranges

    For i = 1 To n
        shift(i, 1) = dat(i + n, 1)
    Next i
    For i = n + 1 To rng.Rows.Count
        shift(i, 1) = dat(i - n, 1)
    Next i

    ShiftVector = shift()
End Function

我还建议在 n 上添加一些范围检查，在 rng 上添加大小/形状检查

_{FWIW 可以通过将最后一行更改为 ShiftVector = Application.Transpose(shift())}

来修复您的代码

【讨论】：