ShiftVector not wrapped around-cells showing zeroes

问题

I'm currently working on this vba programming question.

Here's my code:

Option Explicit

Option Base 1

Function ShiftVector(rng As Range, n As Integer) As Variant
    
    Dim A() As Variant, B() As Variant
    Dim nr As Integer, i As Integer
    
    nr = rng.Rows.Count
    ReDim A(nr, 1) As Variant
    ReDim B(nr, 1) As Variant
    
    A = rng
    
    For i = 1 To nr - n
        If i <= (nr - n) Then
            B(i, 1) = A(i + n, 1)
        End If
    Next i
    
    For i = (nr - n + 1) To nr
        If i <= nr Then
            B(i, 1) = A(i - nr + n, 1)
        End If
    Next i
    
    ShiftVector = B
    
End Function

When n=3, the top 3 items cannot be wrapped down to the bottom. Instead, 0s are showing in the bottom three cells.

Here is the flowchart to the problem.

Any assistance will be much appreciated, thanks!

回答1:

Running your code, it works nicely for values between 0 to the number of rows of rng (including n=3. However, it fails for values of n > nr and also n < 0 (negative), which is important if the user of your function needs to shift the vector down by n positions.

I also have to admit that I struggled to understand the logic of your algorithm and why you need 2 loops to perform the task (entirely a failure on my part).

Edit:

I completely undertand the logic of your algorithm now with the aid of your nice flow-chart. I don't see why it wouldn't work for you, it works well on my computer for 0 <= n <= nr.

End of Edit

In situations like this using Mod seems like the most natural option to me. It accounts for all values of n nicely (positive, negative or zero)

Here is a working code. If you want to build your own algorithm, then look away now :)

Please note the use of Long wherever one might be tempted to use Integer, but obviously you should change it if it is a requirement of the question.

Function ShiftVector(rng As Range, n As Long) As Variant
    
  Application.Volatile
  
  Dim aResult() As Variant
  Dim vRng As Variant
  Dim lRows As Long
  Dim i As Long
  Dim i_new As Long
  
  vRng = rng.Value ' Process vector more efficiently
  lRows = rng.Rows.Count ' Don't use Ubound(vRng) here
  ReDim aResult(1 To lRows, 1 To 1)
  
  If lRows = 1 Then
    ' vRng is simply the value of the cell (not array of values)
    ' You'll get an error in you try something like vRng(i, 1)
    aResult(1, 1) = vRng
  Else
    For i = 1 To lRows
      ' This is the transformation rule.
      ' Using Mod is the most natural way in this case
      ' and works for all values of n (+, - and 0).
      ' iRows * Abs(n) ensures (i - n + iRows * Abs(n)) > 0
      i_new = (i - n + lRows * Abs(n)) Mod lRows
      
      ' If n is a multiple of iRows then i_new=0
      If i_new = 0 Then i_new = lRows
      
      ' Perform transformation
      aResult(i_new, 1) = vRng(i, 1)
    Next i
  End If
  
  ShiftVector = aResult
End Function

回答2:

Something like this:

Function ShiftVector(rng As Range, n As Integer) As Variant
    
    Dim A As Variant, B As Variant
    Dim nr As Long, i As Long, pos As Long
    
    A = rng.Value
    nr = UBound(A, 1)
    ReDim B(1 To nr, 1 To 1)
    For i = 1 To nr
        pos = IIf(i > n, i - n, (nr - n) + i)
        B(pos, 1) = A(i, 1)
    Next i
    ShiftVector = B
End Function

FYI I would avoid Option Base 1 in VBA - the default base is zero and it's best to leave it at that. And Option Base 1 has no impact on the base of an array obtained using someRange.Value (always 1)

来源：https://stackoverflow.com/questions/62769865/shiftvector-not-wrapped-around-cells-showing-zeroes

标签

vba