Как сдвинуть значения в массиве на n единиц в VBA

Question

Предположим, у меня есть столбец значений

1
2
3
4
5

Я пытаюсь написать функцию VBA, в которой на основе того, какое число я выбрал (n), ячейки будут зацикливаться на этой позиции.Скажем, я выбрал 3

Тогда новый список будет

4
5
1
2
3

То, что я сделал, основано на каждом номере строки, я пытался разработать правила для перемещения ячеек, но это неКажется, это не работает .. Я подозреваю, что это потому, что я использую activerow, а не относительную позицию строки, но я не уверен, что синтаксис для относительной строки.Может ли кто-нибудь помочь мне

Option Explicit

Option Base 1



 Function DivisibleByN(rng As Range, n As Integer) As Variant
    Dim i As Integer, j As Integer
    Dim nr As Integer, nc As Integer
    Dim B() As Variant
    Dim r As ListRow
    nr = rng.Rows.Count
    nc = rng.Columns.Count
    r = ActiveCell.Row
    ReDim B(nr, nc) As Variant
    For i = 1 To nr
        For j = 1 To nc
            If r = 1 And r < n Then
                B(nr - (n - 1), j) = rng.Cells(i, j)
            ElseIf r > 1 And r < n Then
                B(nr - (n - r), j) = rng.Cells(i, j)
            ElseIf r > n Then
                B(r - n, j) = rng.Cells(i, j)
            ElseIf r = n Then
                 B(r, j) = rng.Cells(i, j)
            End If
        Next j
    Next i
    DivisibleByN = B
    End Function

Answer 1

вы можете использовать это

Function DivisibleByN(rng As Range, n As Integer) As Variant
    Dim i As Long, j As Long

    With rng
        ReDim B(0 To .Rows.Count - 1, 0 To .Columns.Count - 1) As Variant
        For i = .Rows.Count To 1 Step -1
            For j = 1 To .Columns.Count
                B(i - 1, j - 1) = .Cells((.Rows.Count + i - (n + 1)) Mod .Rows.Count + 1, j)
            Next
        Next
        DivisibleByN = B
    End With
End Function

Answer 2

Это было просто возиться с COM-объектами и исследовать их ... можно привести в порядок. S & G момент.

Option Explicit
Public Sub test()
    Const n As Long = 3 '<==Add your end point here
    Dim arr(), i As Long, rng As Range
    With ThisWorkbook.Worksheets("Sheet6") '<==Put your sheet name here
        Set rng = .Range("A1:A5") '<== Add your single column range here
        Dim maxValue As Variant
        Dim minValue As Variant
        maxValue = Application.Max(rng)
        minValue = Application.Min(rng)
        If IsError(maxValue) Or IsError(minValue) Then Exit Sub

        If n > maxValue Or n < minValue Then Exit Sub
        If rng.Columns.Count > 1 Then Exit Sub
        If rng.Cells.Count = 1 Then
            ReDim arr(1, 1): arr(1, 1) = rng.Value
        Else
            arr = rng.Value
        End If

        Dim list As Object, list2 As Object, queue As Object, arr2()
        Set list = CreateObject("System.Collections.ArrayList")
        Set queue = CreateObject("System.Collections.Queue")

        For i = LBound(arr, 1) To UBound(arr, 1)
            list.Add arr(i, 1)
        Next

        list.Sort
        Set list2 = list.Clone
        list2.Clear

        arr2 = list.GetRange(n, maxValue - n).toArray

        For i = LBound(arr2) To UBound(arr2)
            queue.enqueue arr2(i)
        Next

        list2.addRange queue
        queue.Clear
        arr2 = list.GetRange(0, n).toArray

        For i = LBound(arr2) To UBound(arr2)
            queue.enqueue arr2(i)
        Next

        list2.addRange queue
        rng.Cells(1, 1).Resize(list2.Count, 1) = Application.WorksheetFunction.Transpose(list2.toArray)
    End With
End Sub

Answer 3

Предполагая, что вы хотите «свернуть» каждый столбец по отдельности, вы можете сделать что-то вроде этого:

Public Sub RollColumns(ByVal rng As Range, ByVal rollBy As Integer)
    Dim rowsCount As Integer, colsCount As Integer
    Dim rowsOffset As Integer, colsOffset As Integer
    Dim r As Integer, c As Integer

    rowsCount = rng.Rows.Count
    colsCount = rng.Columns.Count
    rowsOffset = rng.Rows(1).Row - 1
    colsOffset = rng.Columns(1).Column - 1

    If rowsCount = 1 Then Exit Sub

    Dim arr As Variant
    arr = rng.Value

    For c = 1 To colsCount
        For r = 1 To rowsCount
           Dim targetIndex As Integer
           targetIndex = (r + rollBy) Mod rowsCount
           If targetIndex = 0 Then targetIndex = rowsCount
           rng.Worksheet.Cells(r + rowsOffset, c + colsOffset).Value = _
                arr(targetIndex, c)
        Next r
    Next c
End Sub

Использование:

RollColumns Range("A1:C5"), 3

См. В действии: