Цикл "For" - как изменить параметр "To"

[rdva]

Набросал цикл:

Код: Выделить всё

Sub experiment()
Application.Workbooks.Item("Power_for_notebooks_17.12.06_препарируемый.xls").Worksheets("(1) Каталог НАШИ").Activate

'транспонируем строку в столбец
Dim Count, Konec As Integer
Konec = Worksheets("(1) Каталог НАШИ").Range("B65535").End(xlUp).Row

For rwIndex = 7 To Konec
        Count = WorksheetFunction.CountA(Range(Cells(rwIndex, 3), Cells(rwIndex, 20)))
        Range(Cells(rwIndex + 1, 2), Cells(rwIndex + Count - 1, 2)).Select
            Selection.EntireRow.Insert
        Range(Cells(rwIndex, 4), Cells(rwIndex, 2 + Count)).Select
            Selection.Copy
        Cells(rwIndex + 1, 3).Select
            Selection.PasteSpecial Paste:=xlPasteAll, Operation:=xlNone, SkipBlanks:= _
            False, Transpose:=True
        rwIndex = rwIndex + Count - 1
        Konec = Worksheets("(1) Каталог НАШИ").Range("B65535").End(xlUp).Row
Next rwIndex
       
End Sub


Так как в процессе работы номер конечной строки постоянно увеличивается, нужно чтобы "To" тоже увеличивался. Данный цикл доходит до значения, полученного переменной"Konec " до начала цикла и останавливается.
Как сделать правильно?

[KL]

А можно увидеть пример исходных данных и конечного результата в виде приложения? Что-то мне подсказывает, что это делается в одно, макс. в два действия.

[rdva]

Вот оно, в реальном исходнике примерно 3500 строк:

[Genyaa]

Мне кажется достаточно было бы перейти с "For" на "Do While" c добавлением посчета счетчика rwIndex внутри цикла...

Мне кажется, что цикл For не переопределяет заданные начальный и конеченый пределы в течение своей работы, даже если переменным, которыми эти пределы заданы, присваиваются новые значения в цикле.

[tyomitch]

Мне кажется, что цикл For не переопределяет заданные начальный и конеченый пределы в течение своей работы, даже если переменным, которыми эти пределы заданы, присваиваются новые значения в цикле.

Это не кажется, это факт.

[bi-lya]

rdva, вам не понравились советы, которые вам дали в вашей предыдущей теме? Там это же, по-моему, обжевали по-всякому и дали минимум два варианта решения того, что вы задаете

[rdva]

rdva, вам не понравились советы, которые вам дали в вашей предыдущей теме? Там это же, по-моему, обжевали по-всякому и дали минимум два варианта решения того, что вы задаете

bv-lya, мне кажется вы невнимательно прочитали первый пост в этой теме. Проблема, озвученная в предыдущей теме, успешно решена, благодаря вам и остальным участникам дискуссии, большое человеческое всем вам спасибо за это. Ну а если с точки зрения знающего человека вопросы мои кажутся идиотскими - прошу простить великодушно, все наверное с идиотских вопросов начинали.

[KL]

попробуй вот это:

Код: Выделить всё

Option Explicit

Sub test()
    Dim lgStep As Long, i As Long
    lgStep = 9
   
    Application.ScreenUpdating = False
    Sheets("Data").Copy , Sheets(Sheets.Count)
   
    With ActiveSheet
        For i = .Cells(.Rows.Count, 1).End(xlUp).Row To 7 Step -1
            .Rows(i + 1).Resize(lgStep - 1).Insert
            .Cells(i, 3).Resize(lgStep) = Application.Transpose(.Cells(i, 3).Resize(, lgStep))
        Next i
        .Range("D:K").ClearContents
    End With
    Application.ScreenUpdating = True
End Sub

[bi-lya]

Да нет, не идиотские, но очень похожи!