Поиск  Пользователи  Правила  Войти
Форумы "Планета Excel" » Вопросы по Microsoft Excel
Страницы: 1
RSS
Вставить пустые строки по условию
 
#1
19.11.2021 14:44:28
Добрый день всем. Есть некая таблица вида:

Название   Ед.изм.
Труба 25        м
Труба 32        м
Кран              шт
Труба 32        м

необходимо вставить две пустые строки выше каждой строки, где Ед.изм. = "м", и одну пустую строку выше каждой строки, где Ед.изм = "шт"
Какие есть варианты?
 
 
 
#2
19.11.2021 14:59:05
kompilainenn, лучше делать файл-пример.
При условии, что с ячейки A1 начинается.

Код
Sub InsertRows()

    Set Rng = Range("A1").CurrentRegion
    RowsCount = Rng.Rows.Count
    
    For i = RowsCount To 1 Step -1
        If Range("B" & i).Value = "м" Then Rows(i).Insert: Rows(i).Insert
        If Range("B" & i).Value = "шт" Then Rows(i).Insert
    Next i
    
End Sub
 
 
 
#3
19.11.2021 15:11:27
Выделите столбец с единицами измерения, запустите макрос.
Код
Sub Добавить_строки()
    Dim rn As Range
    On Error Resume Next
    Set rn = Intersect(Selection, ActiveSheet.UsedRange)
    On Error GoTo 0
    If Not rn Is Nothing Then
        Dim cl As Range
        Dim y As Long
        For y = rn.Cells.Count To 1 Step -1
            Set cl = rn.Cells(y)
            Select Case LCase(cl.Value)
            Case "м"
                cl.EntireRow.Insert
            Case "шт"
                cl.Resize(2).EntireRow.Insert
            End Select
        Next
    End If
End Sub
 
 
 
#4
19.11.2021 16:16:20
Спасибо вам. Макрос из #2 сработал, из #3 нет.

Да, замечание про файл верное. Прошу прощения.
 
 
 
#5
29.07.2022 08:05:39
Здравствуйте!
Задача: есть список состоящий из ячеек с текстом и ячеек с числами, между ячейками с текстом 1 или 2 строки с числами.
Надо: вставить пустую строку, над текстом, что бы между ячейками с текстом всегда было 2 строки.
Пример в приложенном файле.
Пожалуйста помогите!!!
Изменено: antor - 29.07.2022 08:07:37
 
 
 
#6
30.07.2022 17:12:42
Код
Sub uuu()
    Dim rn          As Range
    Dim i As Long, lLastRow As Long

    lLastRow = Cells(Rows.Count, 1).End(xlUp).Row

    Set rn = Range(Cells(ActiveSheet.UsedRange.Row, 1), Cells(lLastRow, 1))


    For i = lLastRow To rn.Row Step -1
        If i > 1 Then If i = 3 And TypeName(Cells(i - 1, 1).Value) = "String" Then Rows(i - 1).EntireRow.Insert

        If i > 3 Then If TypeName(Cells(i, 1).Value) = "String" And Not TypeName(Cells(i - 3, 1).Value) = "String" Then Rows(i).EntireRow.Insert

    Next

End Sub
Изменено: Евгений Корнилов - 30.07.2022 18:45:43
 
 
 
#7
30.07.2022 17:43:47
Евгений Корнилов,  код следует оформлять соответствующим тегом. Ищите кнопку <...> и исправьте своё сообщение.
 
 
 
#8
30.07.2022 23:42:23
МатросНаЗебре, понимаю, что код старый, но посоветую…
Если код продолжается только при выполнении условия, то, вместо постоянного ветвления (в примере только одно) лучше выходить при его невыполнении.
То есть If rn Is Nothing Then Exit Sub  ;)
Изменено: Jack Famous - 30.07.2022 23:42:50
Во всех делах очень полезно периодически ставить знак вопроса к тому, что вы с давних пор считали не требующим доказательств (Бертран Рассел) ►Благодарности сюда◄
 
 
 
Страницы: 1
Наверх