Question

假设我有一列值

我正在尝试编写VBA函数，其中基于我选择的数字（n）细胞会循环到那个位置。所以说我选择了3

那么新列表将是

我所做的是基于每个行号的，我试图开发规则来移动单元格，但是它似乎没有用..我怀疑这是因为我使用的是活动行，而不是相对行位置，但是我不确定相对行的语法是什么。有人可以帮我吗

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

假设您要分别“滚动”每一列，则可以执行以下操作：

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

查看实际效果：

Answer 2

您可以使用此

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 3

这只是弄乱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

如何在VBA中

3 个答案: