Домашняя страница Undo Do New Save Карта сайта Обратная связь Поиск по форуму
МИР MS EXCEL - Гость.xls

Вход

Регистрация

Напомнить пароль

 

= Мир MS Excel/Копирование строки определенное количество раз - Мир MS Excel

Старая форма входа
  • Страница 1 из 1
  • 1
Модератор форума: китин, _Boroda_  
Мир MS Excel » Вопросы и решения » Вопросы по VBA » Копирование строки определенное количество раз (Макросы/Sub)
Копирование строки определенное количество раз
fyx Дата: Вторник, 01.04.2014, 12:17 | Сообщение № 1
Группа: Пользователи
Ранг: Новичок
Сообщений: 10
Репутация: 0 ±
Замечаний: 0% ±

Excel 2003
Добрый день.
Есть строки с указанием количества позиций.
Нужно сделать столько копий этой строки, сколько указанно в столбце количество.
То есть 5 брюк, должно стать 5 строк с брюками.
К сообщению приложен файл: 2599370.xls (34.0 Kb)
 
Ответить
СообщениеДобрый день.
Есть строки с указанием количества позиций.
Нужно сделать столько копий этой строки, сколько указанно в столбце количество.
То есть 5 брюк, должно стать 5 строк с брюками.
Автор - fyx
Дата добавления - 01.04.2014 в 12:17
Dмитрий Дата: Вторник, 01.04.2014, 12:34 | Сообщение № 2
Группа: Пользователи
Ранг: Участник
Сообщений: 91
Репутация: 9 ±
Замечаний: 40% ±

Excel 2010
Цитата
Нужно сделать столько копий этой строки, сколько указанно в столбце количество.

Копий куда??? На новый лист? В новую книгу? Туда же?
 
Ответить
Сообщение
Цитата
Нужно сделать столько копий этой строки, сколько указанно в столбце количество.

Копий куда??? На новый лист? В новую книгу? Туда же?
Автор - Dмитрий
Дата добавления - 01.04.2014 в 12:34
fyx Дата: Вторник, 01.04.2014, 12:38 | Сообщение № 3
Группа: Пользователи
Ранг: Новичок
Сообщений: 10
Репутация: 0 ±
Замечаний: 0% ±

Excel 2003
Туда же, под данною строку.
Далее следующую строку, копируем вниз столько раз сколько указано в строке "Кол-во"
И строк может быть до 200.
 
Ответить
СообщениеТуда же, под данною строку.
Далее следующую строку, копируем вниз столько раз сколько указано в строке "Кол-во"
И строк может быть до 200.
Автор - fyx
Дата добавления - 01.04.2014 в 12:38
Wasilich Дата: Вторник, 01.04.2014, 13:33 | Сообщение № 4
Группа: Друзья
Ранг: Старожил
Сообщений: 1232
Репутация: 326 ±
Замечаний: 0% ±

2003
Так пойдет?
[vba]
Код
Sub КопияСтрок()
    Dim i&, x&
    Application.ScreenUpdating = False
    For i = Range("A" & Rows.Count).End(xlUp).Row To 2 Step -1
      If Cells(i, 9) > 1 Then
         x = i + Cells(i, 9) - 1
         Rows(i + 1 & ":" & x).Insert Shift:=xlDown
         Rows(i).Copy
         Rows(i + 1 & ":" & x).Select
         ActiveSheet.Paste
      End If
    Next
    Application.CutCopyMode = False
    Range("A2").Select
    Application.ScreenUpdating = True
End Sub

[/vba]
 
Ответить
СообщениеТак пойдет?
[vba]
Код
Sub КопияСтрок()
    Dim i&, x&
    Application.ScreenUpdating = False
    For i = Range("A" & Rows.Count).End(xlUp).Row To 2 Step -1
      If Cells(i, 9) > 1 Then
         x = i + Cells(i, 9) - 1
         Rows(i + 1 & ":" & x).Insert Shift:=xlDown
         Rows(i).Copy
         Rows(i + 1 & ":" & x).Select
         ActiveSheet.Paste
      End If
    Next
    Application.CutCopyMode = False
    Range("A2").Select
    Application.ScreenUpdating = True
End Sub

[/vba]
Автор - Wasilich
Дата добавления - 01.04.2014 в 13:33
fyx Дата: Вторник, 01.04.2014, 13:33 | Сообщение № 5
Группа: Пользователи
Ранг: Новичок
Сообщений: 10
Репутация: 0 ±
Замечаний: 0% ±

Excel 2003
Спасибо огромное, заработало


Сообщение отредактировал fyx - Вторник, 01.04.2014, 13:39
 
Ответить
СообщениеСпасибо огромное, заработало
Автор - fyx
Дата добавления - 01.04.2014 в 13:33
AlexM Дата: Вторник, 01.04.2014, 13:44 | Сообщение № 6
Группа: Друзья
Ранг: Участник клуба
Сообщений: 4517
Репутация: 1129 ±
Замечаний: 0% ±

Excel 2003
Еще вариант
[vba]
Код
Sub CopyRows()
Application.ScreenUpdating = False
Dim i As Long
For i = Columns(9).End(xlDown).Row To 2 Step -1
Rows(i).Copy
Rows(i).Resize(Range("I" & i) - 1).EntireRow.Insert
Range("I" & i).Resize(Range("I" & i)) = 1
Next i
Application.CutCopyMode = False
Application.ScreenUpdating = True
End Sub
[/vba]
К сообщению приложен файл: 2599370_new.xls (33.5 Kb)


Номер мобильного модема (без голосовой связи)
9269171249 МегаФон, Московский регион.
 
Ответить
СообщениеЕще вариант
[vba]
Код
Sub CopyRows()
Application.ScreenUpdating = False
Dim i As Long
For i = Columns(9).End(xlDown).Row To 2 Step -1
Rows(i).Copy
Rows(i).Resize(Range("I" & i) - 1).EntireRow.Insert
Range("I" & i).Resize(Range("I" & i)) = 1
Next i
Application.CutCopyMode = False
Application.ScreenUpdating = True
End Sub
[/vba]
Автор - AlexM
Дата добавления - 01.04.2014 в 13:44
fyx Дата: Вторник, 01.04.2014, 13:56 | Сообщение № 7
Группа: Пользователи
Ранг: Новичок
Сообщений: 10
Репутация: 0 ±
Замечаний: 0% ±

Excel 2003
Цитата AlexM, 01.04.2014 в 13:44, в сообщении № 6
Еще вариант


Что то у меня на него ругается на строку
Range("I" & i).Resize(Range("I" & i)) = 1
 
Ответить
Сообщение
Цитата AlexM, 01.04.2014 в 13:44, в сообщении № 6
Еще вариант


Что то у меня на него ругается на строку
Range("I" & i).Resize(Range("I" & i)) = 1
Автор - fyx
Дата добавления - 01.04.2014 в 13:56
AlexM Дата: Вторник, 01.04.2014, 14:03 | Сообщение № 8
Группа: Друзья
Ранг: Участник клуба
Сообщений: 4517
Репутация: 1129 ±
Замечаний: 0% ±

Excel 2003
Проверил на файле, который в 6-ом сообщении. У меня не ругается.
Строка проставляет количество 1 шт в размноженных строках.


Номер мобильного модема (без голосовой связи)
9269171249 МегаФон, Московский регион.
 
Ответить
СообщениеПроверил на файле, который в 6-ом сообщении. У меня не ругается.
Строка проставляет количество 1 шт в размноженных строках.
Автор - AlexM
Дата добавления - 01.04.2014 в 14:03
iramikla Дата: Пятница, 02.05.2014, 12:06 | Сообщение № 9
Группа: Пользователи
Ранг: Прохожий
Сообщений: 6
Репутация: 0 ±
Замечаний: 0% ±

Excel 2007
Все работает, единственный вопрос: если в столбце с количеством есть цифра 1, выскакивает ошибка! можно ли избавиться от этого таким образом, чтобы строка, которая должна повторяться только один раз, оставалась в единственном экземпляре, а другие строки копировались согласно указанному количеству?
 
Ответить
СообщениеВсе работает, единственный вопрос: если в столбце с количеством есть цифра 1, выскакивает ошибка! можно ли избавиться от этого таким образом, чтобы строка, которая должна повторяться только один раз, оставалась в единственном экземпляре, а другие строки копировались согласно указанному количеству?
Автор - iramikla
Дата добавления - 02.05.2014 в 12:06
AlexM Дата: Пятница, 02.05.2014, 12:35 | Сообщение № 10
Группа: Друзья
Ранг: Участник клуба
Сообщений: 4517
Репутация: 1129 ±
Замечаний: 0% ±

Excel 2003
можно так[vba]
Код
Sub CopyRows()
Application.ScreenUpdating = False
Dim i As Long
For i = Columns(9).End(xlDown).Row To 2 Step -1
If Range("I" & i) > 1 Then
Rows(i).Copy
Rows(i).Resize(Range("I" & i) - 1).EntireRow.Insert
Range("I" & i).Resize(Range("I" & i)) = 1
End If
Next i
Application.CutCopyMode = False
Application.ScreenUpdating = True
End Sub
[/vba]


Номер мобильного модема (без голосовой связи)
9269171249 МегаФон, Московский регион.
 
Ответить
Сообщениеможно так[vba]
Код
Sub CopyRows()
Application.ScreenUpdating = False
Dim i As Long
For i = Columns(9).End(xlDown).Row To 2 Step -1
If Range("I" & i) > 1 Then
Rows(i).Copy
Rows(i).Resize(Range("I" & i) - 1).EntireRow.Insert
Range("I" & i).Resize(Range("I" & i)) = 1
End If
Next i
Application.CutCopyMode = False
Application.ScreenUpdating = True
End Sub
[/vba]
Автор - AlexM
Дата добавления - 02.05.2014 в 12:35
iramikla Дата: Пятница, 02.05.2014, 12:45 | Сообщение № 11
Группа: Пользователи
Ранг: Прохожий
Сообщений: 6
Репутация: 0 ±
Замечаний: 0% ±

Excel 2007
Огромнейшее спасибо!!!! все прекрасно работает!) :D
 
Ответить
СообщениеОгромнейшее спасибо!!!! все прекрасно работает!) :D
Автор - iramikla
Дата добавления - 02.05.2014 в 12:45
Мир MS Excel » Вопросы и решения » Вопросы по VBA » Копирование строки определенное количество раз (Макросы/Sub)
  • Страница 1 из 1
  • 1
Поиск:

Яндекс.Метрика Яндекс цитирования
© 2010-2024 · Дизайн: MichaelCH · Хостинг от uCoz · При использовании материалов сайта, ссылка на www.excelworld.ru обязательна!