Страницы: 1
RSS
VBA функция для переноса значений из ячеек в заданном диапазоне
 
В аргументах функции - диапазон. Функция должна переносить значения из ячеек в ячейки ниже в указанном диапазоне.
Написал такую, но что то не работает (выделяет переменную Num).  Файл-пример приложил. Поправьте пожалуйста.
Код
Function Stats(Rng As Range)
Dim CellCount, Num As Integer
Dim Cl(Num) As Object

Cl = Activesheet.Rng.Cells
CellCount = Rng.Cells.Count

    For Num = CellCount To 1
        Cl(Num).Value = Cl(Num - 1).Value
    Next Num

End Function
 
Функция ничего никуда переносить не может, функция только может возвратить значение (или ошибку), причем только в той ячейке (диапазоне) из которой она вызывается
Согласие есть продукт при полном непротивлении сторон
 
Цитата
Sanja написал:
Функция ничего никуда переносить не может
Изменил функцию на процедуру, и так же не работает что мне нужно исправить?
 
Цитата
OSA913 написал: что мне нужно исправить?
Для этого нужно знать что ваша процедура должна делать по Вашей задумке. Без привязки к коду, обычными словами можете объяснить?
Согласие есть продукт при полном непротивлении сторон
 
В параметрах процедуры задаю диапазон. На пример выбираю диапазон A1:A5, и в этом диапазоне значение ячейки A5 должно быть = значению A4, A4=A3, A3=A2, A2=A1. Т.е. все значения должны сместиться на ячейку ниже.
Изменено: OSA913 - 14.03.2019 09:45:40
 
А значение в A1 чему должно быть равно? Старому значению?
Согласие есть продукт при полном непротивлении сторон
 
А1 не меняется, а значение из A5 не смещается вниз, а заменяется значением из A4.
Изменено: OSA913 - 14.03.2019 09:47:54
 
Код
Sub aaa()
ShiftRange Selection
End Sub
Sub ShiftRange(RR As Range)
Dim aa As Range
For Each aa In Selection.Cells
  aa.Offset(, -1) = aa
Next
End Sub
 
Функция
Код
Function Stats(Rng As Range)
Dim arr(), arr1(), I&
arr = Rng.Value
ReDim arr1(1 To UBound(arr))
For I = UBound(arr) To 2 Step -1
    arr1(I) = arr(I - 1, 1)
Next
arr1(1) = arr(1, 1)
Stats = arr1
End Function

Sub test()
    myArr = Stats(Activesheet.Range("A1:A5"))
    MsgBox Join(myArr, ", ")
End Sub
Согласие есть продукт при полном непротивлении сторон
 
Чуть проще, с выгрузкой на лист
Код
Function Stats(Rng As Range)
Dim arr(), I&
arr = Rng.Value
For I = UBound(arr) To 2 Step -1
    arr(I, 1) = arr(I - 1, 1)
Next
Stats = arr
End Function

Sub test()
With Activesheet
    myArr = Stats(.Range("A1:A5"))
    .Range("C1").Resize(UBound(myArr), 1) = myArr
End With
End Sub
Согласие есть продукт при полном непротивлении сторон
 
Sanja, ваш код работает. Anchoret выдает ошибку на строке
Код
aa.Offset(, -1) = aa

Если заменить -1 на 1, тогда дублирует значения в рядом стоящий столбец.
Всех благодарю за помощь.
 
Sanja, а возможно как нить сделать чтобы процедура принудительно не вставляла снова то же значение в верхнюю ячейку (A1)? Потому что в верхней ячейке и так изменяется значение, только другой процедурой, которая идет впереди этой. Так получается что новое значение в верхней ячейке меняется снова на старое.
 
Т.е. Вам нужно заменить значения диапазона НА МЕСТЕ, не затрагивая 1-е значение? Или что?
Согласие есть продукт при полном непротивлении сторон
 
Пробуйте
Код
Function Stats(Rng As Range)
Dim arr(), arr1(), I&
arr = Rng.Value
ReDim arr1(1 To UBound(arr) - 1, 0 To 0)
For I = UBound(arr1) To 1 Step -1
    arr1(I, 0) = arr(I, 1)
Next
Stats = arr1
End Function
 
Sub test()
    myArr = Stats(ActiveSheet.Range("A1:A5"))
    Range("A2").Resize(UBound(myArr), 1) = myArr
End Sub
Согласие есть продукт при полном непротивлении сторон
 
Да, верхнюю ячейку не изменять, а только перенести ее значение ниже.
 
Спасибо!
 
Цитата
OSA913 написал:
ячейку не изменять, а только перенести ее значение
- оксиморон :)
 
Хотел применить последний код к диапазону "горизонтальному" типа "A2:D2", но когда создаю из него массив "arr" , то функция Ubound(arr) равна 1, а если Ubound(arr) из вертикального диапазона типа "A1:A4", то он будет равен 4. Какую функцию нужно применить к этому "горизонтальному" массиву, чтобы она возвращала число элементов массива соответствующего кол-ву ячеек?
Изменено: OSA913 - 18.04.2019 12:06:54
 
Вроде разобрался Ubound(arr,2) надо было.
Страницы: 1
Наверх