Поиск  Пользователи  Правила  Войти
Форумы "Планета Excel" » Вопросы по Microsoft Excel
Страницы: 1
RSS
Как скопировать строку заданное число раз, указанное в ячейке данной строки
 
#1
04.05.2013 11:25:48
Здраствуйте. Подскажите как скопировать строку заданное число раз, указанное в одной из ячеек данной строки? Т.е. имеется большой файл с названиями позиций и их количеством, а нужно пребразовать этот файл, чтобы если позиция имеет количество более единицы, то эта строка превращалась в соответствующее количество строк и количеством единица для каждой строки. В приложении привёл пример, что имею ввиду.
 
 
 
#2
04.05.2013 12:12:09
Была уже точно такая тема.
 
 
 
#3
04.05.2013 14:41:42
Спасибо, нашёл http://planetaexcel.ru/forum/index.php?PAGE_NAME=message&FID=1&TID=45432&MID=378140#message378140
И даже написал свой первый макрос

Код
Sub Копирование()
Rows(ActiveCell.Row).Copy
Cells(Rows.Count, 1).End(xlUp).Offset(0, 0).Resize(ActiveCell - 1, 1).Insert Shift:=xlDown
End Sub


Но не могу разобраться со смещением при копировании. Требуется чтобы при выделении ячейки с числом ниже добавлялись строки в количестве это число минус один, и добавлялись они сразу под этой строкой. А сейчас идут непонятные смещения вниз... А так вроде всё работает.
 
 
 
#4
04.05.2013 19:44:29
Попробовал другой код:
Код

Sub Копирование()
 Dim i&
    Application.ScreenUpdating = False
    For i = 1 To (ActiveCell - 1)
        Rows(ActiveCell.Row).Copy Cells(Rows.Count, 1).End(xlUp)(2)
    Next
    Application.ScreenUpdating = True


End Sub


Всё аналогично присходит... Т.е. при выделении очередной ячейки (например B5) вставка строк происходит не начиная со следующей строки (т.е. с 6-й), а начиная со строки, котороя является последней заполненной в файле.

Т.е. исходные данные такие:
позицияраз 4
позициядва 1
позициятри 6

Хочу получить:
позицияраз 4
позицияраз 4
позицияраз 4
позицияраз 4
позициядва 1
позициятри 6
позициятри 6
позициятри 6
позициятри 6
позициятри 6
позициятри 6
 
 
 
#5
04.05.2013 20:01:51
Цитата
sergex пишет:
Cells(Rows.Count, 1).End(xlUp)(2)
Вот здесь как раз и определяется последняя строка))
Вот такой макрос
Код
Rows(5).Resize(3).Insert
вставит три строки, начиная с пятой. Теперь меняем 5 на номер активной строки, а 3 на значение в нужной ячейке (сколько строк нужно вставить).
P.S. Тему Вы нашли похожую, но была ещё одна аналогичная...
 
 
 
#6
04.05.2013 20:22:48
Уже почти получилось)
Код вышел такой
Код
Sub Копирование()
 Rows(ActiveCell.Row).Resize(ActiveCell - 1).Insert
End Sub


Но есть последняя проблемка, вставляет нужное количество в нужное место, но не активную строку, а пустую..
 
 
 
#7
04.05.2013 20:48:14
Код
Sub TestCopy()
Rows(ActiveCell.Row).Copy
Rows(ActiveCell.Row).Resize(ActiveCell.Offset(0, -1) - 1).Insert 'Shift:=xlDown
Application.CutCopyMode = False
End Sub

количество копируемых строк в ячейке слева от активной.
 
 
 
#8
04.05.2013 21:20:53
Спасибо! Всё заработало!
 
 
 
#9
05.08.2018 11:07:22
День добрый. Понимаю что тема уже старая, однако сейчас очень актуальная для меня.
Есть большой массив данных (более 10 000 ячеек) который нужно размножить на определенное количество раз. И последний код мне фактически подошел, если бы только он не множил по одной выбранной ячейке (на скриншоте показано что выделено было 3 ячейки, но после запуска макроса размножило только выбранную первой). Можно ли как то размножить сразу все ячейки в которых проставлено количество?
 
 
 
#10
05.08.2018 11:42:39
goldenbrown244,  не понятно что хотите сделать, но исходя из написанного и не особо меняя код:
Код
Selection.EntireRow.Copy

Вот так попробуйте копировать после
Цитата
goldenbrown244 написал:
выделено было 3 ячейки
 
 
 
#11
15.08.2018 09:08:13
Попробовал, это уже ближе к истине, но теряется порядок.
Переделал немного табличку, так может быть будет понятнее мой вопрос. На 2м листе разместил скриншоты желаемого результата.  
 
 
 
#12
15.08.2018 10:30:04
sergex, вставить строки в выделенном диапазоне по числу в ячейке + заполнить пустые ячейки значениями из верхних
Изменено: Jack Famous - 15.08.2018 10:35:09
Во всех делах очень полезно периодически ставить знак вопроса к тому, что вы с давних пор считали не требующим доказательств (Бертран Рассел) ►Благодарности сюда◄
 
 
 
#13
16.08.2018 14:42:12
Jack Famous, спасибо большое! Полистал тему, нашел подходящий мне макрос. Однако я не силен в этом всем. Не подскажите ли теперь как не просто подставлять пустые строки, а копировать их? (порядок подстановки вниз вполне устраивает) :)
 
 
 
#14
16.08.2018 14:52:04
Цитата
Man of Mayhem: не просто подставлять пустые строки, а копировать их
когда "размножили" строки по числу в ячейке, то остаётся заполнить образовавшиеся пустоты значениями из верхних ячеек. Ссылку я дал. Спрашивайте конкретнее
Во всех делах очень полезно периодически ставить знак вопроса к тому, что вы с давних пор считали не требующим доказательств (Бертран Рассел) ►Благодарности сюда◄
 
 
 
#15
16.08.2018 15:18:14
Код
Sub qq()
    On Error Resume Next
    Application.ScreenUpdating = False
    For i = Cells(Rows.Count, 2).End(xlUp).Row To 12 Step -1
        Rows(i).Copy
        Rows(i).Resize(Cells(i, 1) - 1).Insert
    Next
    Application.ScreenUpdating = True
End Sub
 
 
 
#16
20.02.2020 22:57:00
Большое спасибо всем участникам данной темы! Нашла решение для своего вопроса :)
:idea:  
 
 
 
#17
16.04.2021 17:05:20
Юрий М, Подскажите пожалуйста, а есть ли обратное действие? у меня дублирующихся строк, справа от них количество, я хочу свернуть уникальные ячейки и чтобы макрос суммировал значение напротив каждой позиции?
 
 
 
#18
16.04.2021 17:06:21
gmb, новая тема с файлом-примером
Во всех делах очень полезно периодически ставить знак вопроса к тому, что вы с давних пор считали не требующим доказательств (Бертран Рассел) ►Благодарности сюда◄
 
 
 
#19
19.04.2021 10:41:55
Jack Famous, создал https://www.planetaexcel.ru/forum/index.php?PAGE_NAME=message&FID=1&TID=139582&a...
 
 
 
Страницы: 1
Читают тему
Наверх