Страницы: 1
RSS
Как скопировать строку заданное число раз, указанное в ячейке данной строки
 
Здраствуйте. Подскажите как скопировать строку заданное число раз, указанное в одной из ячеек данной строки? Т.е. имеется большой файл с названиями позиций и их количеством, а нужно пребразовать этот файл, чтобы если позиция имеет количество более единицы, то эта строка превращалась в соответствующее количество строк и количеством единица для каждой строки. В приложении привёл пример, что имею ввиду.
 
Была уже точно такая тема.
 
Спасибо, нашёл 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


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

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
 
Цитата
sergex пишет:
Cells(Rows.Count, 1).End(xlUp)(2)
Вот здесь как раз и определяется последняя строка))
Вот такой макрос
Код
Rows(5).Resize(3).Insert
вставит три строки, начиная с пятой. Теперь меняем 5 на номер активной строки, а 3 на значение в нужной ячейке (сколько строк нужно вставить).
P.S. Тему Вы нашли похожую, но была ещё одна аналогичная...
 
Уже почти получилось)
Код вышел такой
Код
Sub Копирование()
 Rows(ActiveCell.Row).Resize(ActiveCell - 1).Insert
End Sub


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

количество копируемых строк в ячейке слева от активной.
 
Спасибо! Всё заработало!
 
День добрый. Понимаю что тема уже старая, однако сейчас очень актуальная для меня.
Есть большой массив данных (более 10 000 ячеек) который нужно размножить на определенное количество раз. И последний код мне фактически подошел, если бы только он не множил по одной выбранной ячейке (на скриншоте показано что выделено было 3 ячейки, но после запуска макроса размножило только выбранную первой). Можно ли как то размножить сразу все ячейки в которых проставлено количество?
 
goldenbrown244,  не понятно что хотите сделать, но исходя из написанного и не особо меняя код:
Код
Selection.EntireRow.Copy

Вот так попробуйте копировать после
Цитата
goldenbrown244 написал:
выделено было 3 ячейки
 
Попробовал, это уже ближе к истине, но теряется порядок.
Переделал немного табличку, так может быть будет понятнее мой вопрос. На 2м листе разместил скриншоты желаемого результата.  
 
sergex, вставить строки в выделенном диапазоне по числу в ячейке + заполнить пустые ячейки значениями из верхних
Изменено: Jack Famous - 15.08.2018 10:35:09
Во всех делах очень полезно периодически ставить знак вопроса к тому, что вы с давних пор считали не требующим доказательств (Бертран Рассел) ►Благодарности сюда◄
 
Jack Famous, спасибо большое! Полистал тему, нашел подходящий мне макрос. Однако я не силен в этом всем. Не подскажите ли теперь как не просто подставлять пустые строки, а копировать их? (порядок подстановки вниз вполне устраивает) :)
 
Цитата
Man of Mayhem: не просто подставлять пустые строки, а копировать их
когда "размножили" строки по числу в ячейке, то остаётся заполнить образовавшиеся пустоты значениями из верхних ячеек. Ссылку я дал. Спрашивайте конкретнее
Во всех делах очень полезно периодически ставить знак вопроса к тому, что вы с давних пор считали не требующим доказательств (Бертран Рассел) ►Благодарности сюда◄
 
Код
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
 
Большое спасибо всем участникам данной темы! Нашла решение для своего вопроса :)
:idea:  
 
Юрий М, Подскажите пожалуйста, а есть ли обратное действие? у меня дублирующихся строк, справа от них количество, я хочу свернуть уникальные ячейки и чтобы макрос суммировал значение напротив каждой позиции?
 
gmb, новая тема с файлом-примером
Во всех делах очень полезно периодически ставить знак вопроса к тому, что вы с давних пор считали не требующим доказательств (Бертран Рассел) ►Благодарности сюда◄
 
Jack Famous, создал https://www.planetaexcel.ru/forum/index.php?PAGE_NAME=message&FID=1&TID=139582&a...
Страницы: 1
Наверх