Поиск  Пользователи  Правила 
Закрыть
Логин:
Пароль:
Забыли свой пароль?
Регистрация
Войти
 
Страницы: 1
RSS
Нужно подправить код на вставку со смещением по строкам
 
Всем добрый день!
Нужна помощь с кодом, задача стоит в том, что бы фамилия вставлялась со смещением по строкам на указанную цифру в ячейке рядом.
Пример прилагаю.

Заранее спасибо!
Изменено: Shquall - 29 авг 2016 06:25:53
 
Код
with selection
  .offset(,.offset(,-1))=.value
end with
ели перед выполнением была активной ячейка  фамилией
Живи и дай жить..
 
Слэн, Извиняюсь по строкам смещение не по столбцам...
 
ну сдругой стороны от запятой будет
точнее убрать первую запятую
Изменено: Слэн - 30 авг 2016 00:51:24
Живи и дай жить..
 
Слэн, В это же столбец вставляет, а нужно в столбец А.
 
Цитата
Shquall написал: а нужно в столбец А
Цитата
по строкам смещение не по столбцам
Однако противоречиво получается.
"..Сладку ягоду рвали вместе, горьку ягоду я одна."
 
Код
Sub Макрос()
dim vl
For Each vl In Selection
''' смещение на 2 вниз и 5 влево от выделенной ячейки (дипазона)
   vl.Offset(2, -5).Value = vl.Value
Next
End Sub
Изменено: TSN - 29 авг 2016 06:25:20
 
Владимир, Напишу подробнее: с выбранной ячейки, в данном случае F1, нужно вставить в столбец А и сместиться по строкам на количество, указанное в ячейке возле выбранной в данном случае E1 (на 3 строки вниз т е в ячейку A3 вставляются данные с F1)
 
Чтобы быстро обработать сразу все ячейки, можно сделать так:
Код
Sub Test()
  
  Dim a(), b()
  Dim i As Long, j As Long, k As Long
  
  ' Скопировать значения диапазона данных E:F в массив a()
  a() = Range("E1", Cells(Rows.Count, "F").End(xlUp)).Value
  
  ' Очистить столбец A, если это нужно, то раскомментировать строку ниже
  'ActiveSheet.UsedRange.EntireRow.Columns("A").ClearContents
  
  ' Скопировать существующие значения столбца A в массив b()
  b() = Columns("A").Value
  
  ' Перенести со смещением, указанном в столбца E = a(i,1), значения из столбца F = a(i,2) в столбец A = b(j,1)
  For i = 1 To UBound(a)
    If a(i, 1) Then
      j = i + a(i, 1) - 1 ' Смещение минус 1
      If k < j Then k = j ' Последняя строка с данными в A
      b(j, 1) = a(i, 2)
    End If
  Next
  
  ' Скопировать результат из b() в столбец A
  Range("A1").Resize(k).Value = b()
  
End Sub
Изменено: ZVI - 29 авг 2016 07:01:20
 
ZVI, Немного не так срабатывает. Первый смещается в соответствии указанному числу, а вот остальные смещаются не правильно. Второй указано 5 строка вставился в строку 6 и третий указано 11 строка вставился в 13 строку...

В целом код работает как надо если пересчитать выставленные значения с учетом строк. Спасибо!
Изменено: Shquall - 29 авг 2016 08:27:15
 
Когда говорят о смещении, то нужно указывать относительно чего. Из примеров это не ясно.
Если нужно не смещать относительно каждой ячейки, а помещать абсолютно в строку столбца А, которая задана значением в столбце E, то в коде сообщения #12
вместо строки j = i + a(i, 1) - 1
нужно записать j = a(i, 1)
Изменено: ZVI - 29 авг 2016 09:58:05
Страницы: 1
Читают тему (гостей: 1)
Наверх