Поиск  Пользователи  Правила  Войти
Форумы "Планета Excel" » Вопросы по Microsoft Excel
Страницы: 1
RSS
Дублирование строк заданное число раз
 
#1
10.06.2013 23:50:34
Не могу решить вопрос автоматической обработки файла с копированием строк указанное число раз.
И проставлением номера каждой продублированной строки.
Нашел похожую тему(http://www.planetaexcel.ru/forum/?PAGE_NAME=read&FID=1&TID=48043 http://planetaexcel.ru/forum/?PAGE_NAME=read&FID=1&TID=48811), но не получается ее применить, с макросами сложно совладать.
Можно сделать вручную, но в файле 3600 строк при дублировании должно получиться около 14 тыс, понимаю что займет много времени, поэтому прошу помощи.
 
 
 
#2
11.06.2013 00:27:44
Будет медленно.
Поэтому вывел индикацию в статусбар.
Но на массивах код был бы кажется сложнее...
Код
Sub tt()
    Dim r As Range, rr As Range
    Dim i&, ii&, x&
    Application.ScreenUpdating = False

    Set r = [a1].CurrentRegion
    With Workbooks.Add(1).Sheets(1)
        x = x + 1
        r.Rows(1).Copy .Cells(x, 1)
        For i = 2 To r.Rows.Count
            Application.StatusBar = "Обработка строки " & i
            For ii = r.Rows(i).Cells(7).Value To 1 Step -1
                x = x + 1: r.Rows(i).Copy .Cells(x, 1): .Cells(x, 7) = ii
            Next
        Next
    End With
    Application.StatusBar = False
    Application.ScreenUpdating = True
End Sub
 
 
 
#3
11.06.2013 00:28:22
То есть надо развернуть каждую строку по этажам?
См.пример... Учтите, что макрос берет данные с листа "Sheet1" и записывает результат на лист "Sheet2", предварительно очистив его.
Изменено: AndreTM - 11.06.2013 00:30:33
 
 
 
#4
11.06.2013 00:35:02
Ну и я до кучи... :)
Смотрим лист2 и давим фигуру с побудительной надписью.

Соответственно, код:

Код
Sub InsRows()
Dim lngI As Long
Dim intJ As Integer
    For lngI = Cells(Rows.Count, 1).End(xlUp).Row To 2 Step -1
        Rows(lngI + 1 & ":" & lngI + Cells(lngI, 7) - 1).Insert shift:=xlDown
        Range("A" & lngI & ":" & "I" & lngI).Copy Range("A" & lngI + 1).Resize(Cells(lngI, 7) - 1, 9)
    
        intJ = 1
            Do While intJ < Cells(lngI, 7)
                Cells(lngI + intJ, 7) = Cells(lngI, 7) - intJ
    
                intJ = intJ + 1
            Loop
    Next lngI
End Sub
Кому решение нужно - тот пример и рисует.
 
 
 
#5
11.06.2013 01:06:28
Ну тогда для разнообразия - быстро.
Код
Sub tt()
    Dim a, m&, i&, ii&, x&, y&

    Set a = [a1].CurrentRegion
    m = Application.Sum(a.Columns(7))
    ReDim b(1 To m + 1, 1 To 9)
    a = a.Value: y = y + 1

    For x = 1 To 9: b(y, x) = a(y, x): Next: x = 0

    For i = 2 To UBound(a)
        If i Mod 10 = 0 Then Application.StatusBar = "Обработка строки " & i
        For ii = a(i, 7) To 1 Step -1
            y = y + 1
            For x = 1 To 9: b(y, x) = a(i, x): Next: x = 0
            b(i, 7) = ii
        Next
    Next

    Workbooks.Add(1).Sheets(1).[a1].Resize(y, 9) = b
    Application.StatusBar = False
End Sub

StatusBar всё же оставил - пусть. Хотя и чуть тормозит.
А отключение screenupdating за ненадобностью убрал.
Изменено: Hugo - 11.06.2013 01:08:06
 
 
 
#6
11.06.2013 10:37:50
Выдает ошибку 1004, если строки новые вставляешь...
Может быть это связанно, что изменения по столбцу I происходят в файле?
Изменено: Евгений Ермолаев - 11.06.2013 10:55:39
 
 
 
#7
11.06.2013 12:51:33
1. Где вставляете новые строки? Какие это строки? Пустые? Заполненные?
2. Вторую фразу не понял. А где еще могут происходить изменения по столбцу I?

Выложенный мной пример - работает?
А при каких внесенных изменениях перестает работать?

З.Ы. А, понял.
Слегка изменил код (забыл, что в ячейке может значение 1 стоять и тогда полезет 1004...)
Код
Sub InsRows()
Dim lngI As Long
Dim intJ As Integer
    For lngI = Cells(Rows.Count, 1).End(xlUp).Row To 2 Step -1
    If Cells(lngI, 7) > 1 Then
        Rows(lngI + 1 & ":" & lngI + Cells(lngI, 7) - 1).Insert shift:=xlDown
        Range("A" & lngI & ":" & "I" & lngI).Copy Range("A" & lngI + 1).Resize(Cells(lngI, 7) - 1, 9)
    
        intJ = 1
            Do While intJ < Cells(lngI, 7)
                Cells(lngI + intJ, 7) = Cells(lngI, 7) - intJ
    
                intJ = intJ + 1
            Loop
    End If
    Next lngI
End Sub
Изменено: Пытливый - 12.06.2013 00:20:44
Кому решение нужно - тот пример и рисует.
 
 
 
#8
02.02.2014 04:26:43
Помогите, пожалуйста, и мне с этим вопросом :oops:  Я совершенно не понимаю в макросах ничего. Прикладываю файл с задачей, нужно также повторить строку с информацией о товаре то количество раз, которое стоит в ячейке "кол-во"
 
 
 
#9
02.02.2014 04:47:05
katikatina, повторю  вопрос
 
 
 
Страницы: 1
Читают тему
Наверх