Сортировка вектора в Excel VBA - PullRequest
0 голосов
/ 04 ноября 2018

Я ОЧЕНЬ новичок в Excel VBA. Я хочу написать функцию, которая смещает ячейки в текущем векторе (диапазон, выбранный пользователем) на величину, также указанную пользователем.

Ячейки должны быть перемещены вверх из массива на «n», а затем должны отображаться в нижней части того же массива после перемещения оставшихся ячеек вверх, чтобы занять место ячеек, сдвинутых вверх и из массив.

Буду очень признателен за любой совет, текущий код, который я написал, не работает, и я слишком мало знаю, чтобы помочь себе.

Большое спасибо!

Function ShiftVector(rng As Range, n As Integer)
    'User selects a vector and inputs an integer.
    'The vector must be sorted upwards by the amount equal to the entered integer

    Dim i As Integer, rw As Integer, temp As Variant

    rw = rng.rows.Count

    ReDim b(1 To rw) As Variant
    ReDim temp(1 To n) As Variant

    b = rng
    For i = 1 To n
        temp = b(i)
        'move the data in cells i=1 to n to the temporary array
    Next i

    b(i) = rng.Offset(-n, 0)
    'move the cells in array b up by n

    For i = rw - n To nr
        b(i) = temp
        i = i + 1

        'I'm not sure if this is correct: I want to replace the top shifted cells
        'back into the bottom of array b
     Next i
     ShiftVector4 = b

     'The function must output the newly assembled array b where
     'the top cells that were moved up n-spaces are now wrapped
     'around and are shown at the bottom of the array b
 End Function

1 Ответ

0 голосов
/ 04 ноября 2018

Примерно так должно работать:

Sub Tester()
    ShiftUp Range("B4:C13"), 3
End Sub


Sub ShiftUp(rng As Range, numRows As Long)
    Dim tmp
    With rng
        tmp = .Rows(1).Resize(numRows).Value
        .Rows(1).Resize(.Rows.Count - numRows).Value = _
          .Rows(numRows + 1).Resize(.Rows.Count - numRows).Value
        .Rows((.Rows.Count - numRows) + 1).Resize(numRows).Value = tmp
    End With
End Sub

Как UDF:

Function ShiftUp(rng As Range, numRows As Long)
    Dim d, dOut, r As Long, c As Long, rMod As Long, rTot As Long
    Dim break As Long
    d = rng.Value
    dOut = rng.Value 'as a shortcut to creating an empty array....
    rTot = UBound(d, 1)
    break = rTot - numRows
    For r = 1 To rTot
        For c = 1 To UBound(d, 2)
            'figure out which input row to use...
            rMod = IIf(r <= break, r + numRows, -(break - r))
            dOut(r, c) = d(rMod, c)
        Next c
    Next r
    ShiftUp = dOut
End Function

Обратите внимание, что это формула массива, поэтому вам нужно будет выбрать диапазон того же размера, что и диапазон ввода, и ввести формулу, используя Ctrl Shift Enter

Добро пожаловать на сайт PullRequest, где вы можете задавать вопросы и получать ответы от других членов сообщества.
...