将向上移动向量的 Excel VBA 数组函数

Question

I need an array function that will shift up a vector at rng range by n cells. Here is my code so far:

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

I have tested running this as a subroutine and saw that in the locals window the new array "shift()" had the values I needed, however I am having trouble outputting the new array as a function in a new location show below:

Answer 1

When dealing with Ranges its easiest to work 2D Arrays. Also, your logic can be simplified quite a bit.

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

I'd also suggest adding some range checks on n and size/shape checks on rng

_{FWIW your code could be fixed by changing the last line to ShiftVector = Application.Transpose(shift())}