Страницы: 1
RSS
Копирования строк в количетве указанном в этой строке, Нужен макрос для копирования строк к количетве указанном в определеннои столбце этой строки
 
Добрый день, уважаемые форумчане!
Суть вопроса в следующем:
Есть таблица, с текстовыми и числовыми данными, и необходимо добавить ниже каждой строки копии этой самой строки в количестве указанном в определенном столбце этой строки.

Привожу пример, а так же прикладываю файл .xlsx:

Исходная таблица:
ПодразделениеДолжностьКоличество
 штатных
  единиц
Оклад
Отдел №1Начальник отдела110000
Отдел №1Экономист35000
Отдел №2Инженер56000
Отдел №2Программист2,57000
.
То, что нужно получить:
ПодразделениеДолжностьКоличество
 штатных
  единиц
Оклад
Отдел №1Начальник отдела110000
Отдел №1Экономист35000
Отдел №1Экономист35000
Отдел №1Экономист35000
Отдел №2Инженер56000
Отдел №2Инженер56000
Отдел №2Инженер56000
Отдел №2Инженер56000
Отдел №2Инженер56000
Отдел №2Программист2,57000
Отдел №2Программист2,57000
Отдел №2Программист2,57000
.
Как мы видим, каждую строку размножили в количестве указанном в столбце "Количество штатных единиц" за вычетом одной, уже существующей.
Надо учесть, что неполные единицы (Программист - 2,5 единицы) нужно копировать округляя количество добавляемых строк до целого в большую сторону.
Изменено: strukov - 04.08.2016 13:10:21
 
С такой постановкой вопроса Вам в ветку "Работа"
Учимся сами и помогаем другим...
 
Код
    For iY = Cells(Rows.Count, 1).End(xlUp).Row To 4 Step -1
        n = WorksheetFunction.RoundUp(Cells(iY, 3).Value, 0) - 1
        For i = 1 To n
            Rows(iY + 1).Insert
            Rows(iY).Copy Rows(iY + 1)
            Cells(iY + 1, 1).Value = "Отдел №" & CStr(n - i + 2)
        Next
    Next

И полтора землекопа.
 
estrukov,как вставить пустые строки по числу в ячейке смотрите ТУТ. Как заполнить образовавшееся пустое пространство значениями смотрите ТУТ ;)
Для округления числа в большую сторону до целого используйте доп. столбец с функцией =ОКРУГЛВВЕРХ(ссылка на ячейку;0)
Изменено: Jack Famous - 04.08.2016 12:51:31
Во всех делах очень полезно периодически ставить знак вопроса к тому, что вы с давних пор считали не требующим доказательств (Бертран Рассел) ►Благодарности сюда◄
 
Немного исправил тему и прикрепленный файл.
 
 
Код
   For iY = Cells(Rows.Count, 1).End(xlUp).Row To 4 Step -1
        n = WorksheetFunction.RoundUp(Cells(iY, 3).Value, 0) - 1
        For i = 1 To n
            Rows(iY + 1).Insert
            Rows(iY).Copy Rows(iY + 1)
        Next
    Next
 
МатросНаЗебре, теперь всё как надо. Спасибо!  
 
Вариант формульный.
"..Сладку ягоду рвали вместе, горьку ягоду я одна."
Страницы: 1
Наверх