Нужна помощь для смещения вектора с помощью функции массива в Excel VBA - PullRequest
0 голосов
/ 05 августа 2020

Мне нужно сдвинуть элементы вектора (mx1) вверх на n строк. Последние 3 ячейки становятся "0" (ноль) вместо соответствующих. Я поделился задачей и своим кодом ниже. Рад дальнейшей помощи.

задача

Option Explicit
Option Base 1

Function ShiftVector(rng As Range, n As Integer)
    Dim i As Integer, nr As Integer, b() As Variant
    
nr = rng.Rows.Count
ReDim b(nr, 1) As Variant
    
    For i = 1 To n
        b(i, 1) = rng.Cells(i + n, 1)
    Next i
    For i = n + 1 To nr
        b(i, 1) = rng.Cells(i - n, 1)
    Next i

    ShiftVector = WorksheetFunction.Transpose(b())
End Function

Ответы [ 2 ]

1 голос
/ 05 августа 2020

Как можно ближе к вашему коду:

Function ShiftVector(rng As Range, n As Long)
    Dim i As Long, nr As Long, b() As Variant
    
    nr = rng.Rows.Count
    ReDim b(nr, 1) As Variant
    
    For i = 1 To n
        b(nr - n + i, 1) = rng.Cells(i, 1)
    Next i
    For i = n + 1 To nr
        b(i - n, 1) = rng.Cells(i, 1)
    Next i

    ShiftVector = b()
    
End Function

Дополнительные подсказки

Предполагая, что приведенный выше вопрос является упражнением, вы можете рассматривать приведенный выше код как обучающий шанс и сравните его с исходным кодом. Как правило, я бы предпочел, чтобы подход @ScottCraner проходил через двумерный массив, который не так требует времени , как цикл через диапазон с помощью VBA, по крайней мере, для больших наборов данных.

Лучше объявлять счетчики для таких данных как Long вместо Integer, поскольку строки сегодняшнего диапазона (1048576, ранее 65k) намного превышают ограничение целочисленных данных (от -32,768 до 32,767).

Вам не нужно транспонировать массив b, поскольку он уже двумерный и может быть вставлен как вертикальный набор данных.

Предложение по улучшению

Вы можете назначить весь набор данных в 2-мерный (на основе 1) массив, например, как показано ниже

    Dim tmp As Variant
    tmp = rng.Value 

Изменяя смещение диапазона, вы можете автоматически сдвинуть основную часть данных (с сохранением того же размера диапазона) :

    tmp = rng.Offset(n).Value 

Это позволяет вам повторно ввести только n данные «обернуть» до конца предварительно заполненного массива tmp:

Пример функции

Function SV(rng As Range, n As Long)
'a) get main part (starting n rows higher)
    Dim tmp As Variant
    tmp = rng.Offset(n)       ' shift up vertically (by n rows)
'b) get "wrap around" part of n first rows
    Dim wrap
    wrap = rng.Resize(n, 1)    ' assign to temporary array
'c) enter "wrap around" values to n bottom rows
    Dim i As Long
    For i = 1 To n
        tmp(UBound(tmp) - n + i, 1) = wrap(i, 1)
    Next i
'c) return rearranged array as function result
    SV = tmp
End Function

1 голос
/ 05 августа 2020

Вы были близки, но вам нужен отдельный счетчик для вывода в b. Я также предпочитаю делать вывод в виде 2D-массива и избегать WorksheetFunction.Transpose()

Function ShiftVector(rng As range, n As Integer)
    If rng.Count < n Then Exit Function
    
  
    Dim rngArr() As Variant
    rngArr = rng.Value
    
    ReDim b(1 To UBound(rngArr, 1), 1 To 1)
    
    Dim j As Long
    j = 1
    
    Dim i As Long
    For i = n + 1 To UBound(rngArr, 1)
        b(j, 1) = rngArr(i, 1)
        j = j + 1
    Next i
    For i = 1 To n
        b(j, 1) = rngArr(i, 1)
        j = j + 1
    Next i
    
    
    ShiftVector = b
End Function

введите описание изображения здесь

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