Страницы: 1
RSS
Добавление новой строки при выполнении условия
 
Здравствуйте форумчане!
Столкнулся с необходимостью добавления новой строки при определенном условии.

В столбце "К" от "К2" до "К100" располагается формула "ЕЧИСЛО", соответственно в каждой ячейке записано "ИСТИНА/ЛОЖЬ".
Требуется выполнить: если "К2"=ИСТИНА то под "К2" следует добавить пустую строку. (Для того чтобы в последствии продублировать значения в строке) и так далее до тех пор пока в очередной ячейке "К" либо не будет "ЛОЖЬ" либо пока все ячейки диапазона не проверятся на это условие.

Что-то типа такого (только у меня при такой записи если ключевая ячейка не пустая, условие выполняется):
Код
Range("K2").Select
    If activcell = ИСТИНА Then
    Range("K3").Select
    Selection.EntireRow.Insert
 
Код
Sub opa()
lr = ThisWorkbook.Sheets(1).Cells(Rows.Count, 11).End(xlUp).Row
For f = lr To 2 Step -1
With ThisWorkbook.Sheets(1).Cells(f, 11)
If .Value = True Then
ThisWorkbook.Sheets(1).Rows(f + 1).EntireRow.Insert shift:=xlDown
End If
End With
Next f
End Sub
Изменено: K-SerJC - 18.09.2019 12:52:10
 
Спасибо ОГРОМНОЕ!!!!
 
Снова здравствуйте! Когда этот макрос располагается в книге, то все работает. Когда его добавляешь в надстройку. Почему-то та часть которая добавляет строки перестает работать.
Удалил все лишнее из надстройки. Оставил только: подгрузка блоков > MicromineExplo2
Для проверки работоспособности высылаю файл надстройки, а также файл для теста.
 
Цитата
K-SerJC написал:
Sub opa()lr = ThisWorkbook.Sheets(1).Cells(Rows.Count, 11).End(xlUp).RowFor f = lr To 2 Step -1With ThisWorkbook.Sheets(1).Cells(f, 11)If .Value = True ThenThisWorkbook.Sheets(1).Rows(f + 1).EntireRow.Insert shift:=xlDownEnd IfEnd WithNext fEnd Sub
Не понимаю, не работает в надстройке. В обычной книге все нормально.
Страницы: 1
Наверх