Как сделать копию столбцов с формулами в определенном диапазоне через определенный интервал?
Пример прикреплен: Лист1 - было, а Лист2 – желательный результат. Столбцов и строк несколько сотен. В примере, 2 раза копия через один интервал, но так будет не всегда, поэтому важно указание диапазона и возможность поменять шаг копирования.
Есть подобная тема копирование столбцов n-ое кол-во раз, но там данные без формул и привязанное копирование без интервала, хотя можно наверное как-то модифицировать макрос, как?
Или можно ли изменить это макрос интервального дублирования? [vba]
Код
Sub Макрос() Dim lstCol&, copyCol&, n&, m&, i& lstCol = 10 copyCol = 3 n = 2 m = 3 For i = lstCol To 1 Step -m Columns(i).Copy Columns(i).Offset(, 1).Resize(, n).Insert Shift:=xlToRight Next End Sub
[/vba]
Помогите с макросом кто сможет такое.
Как сделать копию столбцов с формулами в определенном диапазоне через определенный интервал?
Пример прикреплен: Лист1 - было, а Лист2 – желательный результат. Столбцов и строк несколько сотен. В примере, 2 раза копия через один интервал, но так будет не всегда, поэтому важно указание диапазона и возможность поменять шаг копирования.
Есть подобная тема копирование столбцов n-ое кол-во раз, но там данные без формул и привязанное копирование без интервала, хотя можно наверное как-то модифицировать макрос, как?
Или можно ли изменить это макрос интервального дублирования? [vba]
Код
Sub Макрос() Dim lstCol&, copyCol&, n&, m&, i& lstCol = 10 copyCol = 3 n = 2 m = 3 For i = lstCol To 1 Step -m Columns(i).Copy Columns(i).Offset(, 1).Resize(, n).Insert Shift:=xlToRight Next End Sub
Нечего по форумам как белка скакать. А уж если скакать, то везде. А то вчера, глядя на ваш оживленный диалог на Планете, я решил, что мой макрос не нужен. И да, задавая вопрос по макросам, не грех и файл прикладывать с макросом. [vba]
Код
Sub Макрос() Dim lstCol&, copyCol, n, m, i&, x x = InputBox("Укажите последний столбец") If Len(x) Then Else Exit Sub If IsNumeric(x) Then lstCol = Val(x) Else lstCol = Columns(x).Column copyCol = InputBox("Укажите число копий") If IsNumeric(copyCol) Then copyCol = Val(copyCol) Else Exit Sub n = InputBox("Укажите число копируемых столбцов") If IsNumeric(n) Then n = Val(n) Else Exit Sub m = InputBox("Укажите шаг копирования") If IsNumeric(m) Then m = Val(m) Else Exit Sub With ActiveSheet For i = lstCol To lstCol - copyCol * (m - 1) Step -m .Columns(i).Copy .Columns(i).Offset(, 1).Resize(, n).Insert Shift:=xlToRight x = Intersect(.UsedRange, .Columns(i)).Formula For j = 1 To n Intersect(.UsedRange, .Columns(i).Offset(, j)).Value = x Next Next End With End Sub
[/vba]
Нечего по форумам как белка скакать. А уж если скакать, то везде. А то вчера, глядя на ваш оживленный диалог на Планете, я решил, что мой макрос не нужен. И да, задавая вопрос по макросам, не грех и файл прикладывать с макросом. [vba]
Код
Sub Макрос() Dim lstCol&, copyCol, n, m, i&, x x = InputBox("Укажите последний столбец") If Len(x) Then Else Exit Sub If IsNumeric(x) Then lstCol = Val(x) Else lstCol = Columns(x).Column copyCol = InputBox("Укажите число копий") If IsNumeric(copyCol) Then copyCol = Val(copyCol) Else Exit Sub n = InputBox("Укажите число копируемых столбцов") If IsNumeric(n) Then n = Val(n) Else Exit Sub m = InputBox("Укажите шаг копирования") If IsNumeric(m) Then m = Val(m) Else Exit Sub With ActiveSheet For i = lstCol To lstCol - copyCol * (m - 1) Step -m .Columns(i).Copy .Columns(i).Offset(, 1).Resize(, n).Insert Shift:=xlToRight x = Intersect(.UsedRange, .Columns(i)).Formula For j = 1 To n Intersect(.UsedRange, .Columns(i).Offset(, j)).Value = x Next Next End With End Sub
RAN, [offtop]По поводу форумов , не было комментариев из-за простоты и понятности работы вашего макроса, а на Планете вопросы были и подходы разные. Также не ожидал активной реакции и участия. Сразу утром добавил репутацию.[/offtop]
По поводу этого макроса: или я чего-то не понимаю или? Применяю макрос к листу1 примера: "Укажите последний столбец" – H "Укажите число копий" – 2 "Укажите число копируемых столбцов" – 3 "Укажите шаг копирования" – 2 (разве это не то же что и число копий? здесь же не дублирование) Итог – Лист2 примера никак не получается. Подскажите где моя ошибка?
RAN, [offtop]По поводу форумов , не было комментариев из-за простоты и понятности работы вашего макроса, а на Планете вопросы были и подходы разные. Также не ожидал активной реакции и участия. Сразу утром добавил репутацию.[/offtop]
По поводу этого макроса: или я чего-то не понимаю или? Применяю макрос к листу1 примера: "Укажите последний столбец" – H "Укажите число копий" – 2 "Укажите число копируемых столбцов" – 3 "Укажите шаг копирования" – 2 (разве это не то же что и число копий? здесь же не дублирование) Итог – Лист2 примера никак не получается. Подскажите где моя ошибка?kogotex
Ваш макрос _дублирования_ прекрасен, особенно в теме про _копирование_!
Это другая тема, здесь прикреплен другой пример, с другим именем и нужен другой результат. Старый макрос дублирования приведен как пример простой и понятной работы с интервалом, с надеждой, что он будет изменен под приложенный к теме пример. А я все думаю какой-такой "J", почему "J", нет в прикрепленном примере никаких данных в столбце "J"...
P.S.: За доработанный до совершенства макрос дублирования кстати дополнительное спасибо.
RAN,
Ваш макрос _дублирования_ прекрасен, особенно в теме про _копирование_!
Это другая тема, здесь прикреплен другой пример, с другим именем и нужен другой результат. Старый макрос дублирования приведен как пример простой и понятной работы с интервалом, с надеждой, что он будет изменен под приложенный к теме пример. А я все думаю какой-такой "J", почему "J", нет в прикрепленном примере никаких данных в столбце "J"...
P.S.: За доработанный до совершенства макрос дублирования кстати дополнительное спасибо.kogotex
Сообщение отредактировал kogotex - Пятница, 05.05.2017, 08:18