Страницы: 1
RSS
Макрос для дублирования каждой строки таблицы определенное количество раз (с нумерацией)., записан через авторекордер и изменен., работает некорректно
 
UPD добавлено подробное название и описание темы
Всем привет.
Не могу понять, почему немного модернизированный макрос работает некорректно (5 строчек кода), прошу помощи.
Задача: каждую строку таблицы продублировать 12 раз, в первом столбце пронумеровать соответственно (1-12).
Записал первую строку авторекордером, подкорректировал - все работает. Задал диапазоны (один в один) - почему-то автозаполнение вставляет 24 строки вместо 12...
 
У Вас зависимость вставки строк от ячейки [g1], в которой значение формируется какими то формулами, отсюда вся проблема.
Код
Sub Макрос4()
    Dim i&, lrow&
    lrow = Range("b" & Rows.Count).End(xlUp).Row
    For i = lrow To 2 Step -1
         Rows(i+1).Resize(12).Insert
         Rows(i).Resize(13).FillDown
    Next i
End Sub


Я бы тему назвал так: Дублирование каждой строки таблицы определенное количество раз.
Изменено: Nordheim - 04.12.2018 16:01:51
"Все гениальное просто, а все простое гениально!!!"
 
Nordheim, спасибо за ответ и пример.

В левой колонке нужны цифры от 1 до 12 для всех добавленных значений... я поэтому и думал использовать автофильтр как самый простой способ автоматического проставления номеров.
Цитата
Nordheim написал:
У Вас зависимость вставки строк от ячейки [g1],
Я полагал, что прописав ncell = [g1].Value в коде, я установил данное значение до выполнения всего кода, нет?

UPD в ячейке g1 поиск последнего положения цифры 12, чтобы понимать, до какой строки таблица уже была обработана (ну, это моя логика была).
Добавил столбец правее, как должна таблица выглядеть.
Изменено: Евгений - 04.12.2018 16:45:03
 
Цитата
Евгений написал:
Добавил столбец правее, как должна таблица выглядеть.
Ну в таком случае так:
Код
Sub test()
    Dim i&, lrow&
    lrow = Range("b" & Rows.Count).End(xlUp).Row
    For i = lrow To 2 Step -1
         Rows(i + 1).Resize(12).Insert
         Cells(i, 2).Resize(13, 4).FillDown
    Next i
End Sub
"Все гениальное просто, а все простое гениально!!!"
 
Цитата
Nordheim написал:
Ну в таком случае так:
нумерации от 1 до 12 не появляется...
 
вариант на массивах

Код
Sub ttt()
    Dim arr(), i&, j&, k&, l&
    arr = [b1].CurrentRegion.Value
    ReDim iarr(1 To (UBound(arr) - 1) * 12, 1 To UBound(arr, 2))
    For i = 2 To UBound(arr)
        For k = 1 To 12
            l = l + 1
            For j = 2 To UBound(arr, 2)
                iarr(l, j) = arr(i, j)
                iarr(l, 1) = k
            Next j
            If k <> 1 Then iarr(l, UBound(arr, 2)) = Empty
        Next k
    Next i
    [b2].Resize(l, UBound(arr, 2)).Value = iarr
End Sub
"Все гениальное просто, а все простое гениально!!!"
 
Nordheim, спасибо огромное, все работает! Правда, все цифры тоже копируются, но это устранимо... наверное)

Один вопрос - у меня через f8 не получается пошагово отследить, т.е.желтая полоса двигается, но на листе никаких изменений не происходит... это с чем связано? Сначала формируется весь массив, а потом он разом копируется на страницу?
 
Цитата
Евгений написал:Правда, все цифры тоже копируются, но это устранимо... наверное)
Макрос сделан под конкретный пример, уберите все лишнее и оставьте только таблицу. В итоге должно получится как было задумано (на примере справа).
Цитата
Евгений написал:Сначала формируется весь массив, а потом он разом копируется на страницу?
Совершенно верно все формирование происходит в массиве, а потом разом выгружается на лист, это в разы быстрей чем работать с вставкой строк, особенно скорость будет заметна на нескольких тысячах строк.
Изменено: Nordheim - 05.12.2018 09:43:01
"Все гениальное просто, а все простое гениально!!!"
 
Nordheim, очень круто, спасибо еще раз!
Страницы: 1
Наверх