Вставить строку с текстом над первой строкой со словом в яч

Старая форма входа

Страница 1 из 1 1
Модератор форума: китин, _Boroda_

Мир MS Excel » Вопросы и решения » Вопросы по VBA » Вставить строку с текстом над первой строкой со словом в яч (Макросы/Sub)

Gjlhzl

Дата: Воскресенье, 05.11.2023, 17:06 | Сообщение № 1

Группа: Проверенные

Ранг: Форумчанин

Сообщений: 100

Репутация: 0 ±

Замечаний: 0% ±

День добрый, помогите подправить макрос:
--находит первое слово (список отсортирован и строк с определенным словом несколько) в столбце и в зависимости от его значения вставляет нан этой строкой строку с определенным текстом
"нарыл" макрос но он вставляет над всеми строками и как то не так...по сути нужно вставить наименования разделов строк

[vba]

Код

Sub Наименование_раздела()
Dim PS As Long
Dim i As Long
PS = Range("C" & Rows.Count).End(xlUp).Row
For i = PS To 2 Step -1
    If Cells(i, 3).Value Like "*РАЗБОР*" Then
    Rows(i - 1).Interior.ColorIndex = 15
    Rows(i - 1).Insert
    Cells(i - 1, 2) = "ДЕМОНТАЖНЫЕ РАБОТЫ"
    End If
Next
For i = PS To 2 Step -1
    If Cells(i, 3).Value Like "*СТЕН*" Then
    Rows(i - 1).Interior.ColorIndex = 15
    Rows(i - 1).Insert
    Cells(i - 1, 2) = "СТЕНЫ"
    End If
Next
For i = PS To 2 Step -1
    If Cells(i, 3).Value Like "*СТЯЖ*" Then
    Rows(i - 1).Interior.ColorIndex = 15
    Rows(i - 1).Insert
    Cells(i - 1, 2) = "ПОЛЫ"
    End If
Next

End Sub

[/vba]

К сообщению приложен файл: prim.xlsb (18.7 Kb)

Ответить

WowGun

Дата: Воскресенье, 05.11.2023, 21:02 | Сообщение № 2

Группа: Проверенные

Ранг: Новичок

Сообщений: 26

Репутация: 3 ±

Замечаний: 0% ±

Я бы пошел другим путем

[vba]

Код

Sub bob()
PS = Range("C" & Rows.Count).End(xlUp).Row

t = Cells(2, 3)

If t <> "" Then
    Rows(2).Insert
    Range("A2:C2").Interior.ColorIndex = 15
    If t Like "*РАЗБОР*" Then
        p = "ДЕМОНТАЖНЫЕ РАБОТЫ"

    ElseIf t Like "*СТЕН*" Then
        p = "СТЕНЫ"

    ElseIf t Like "*СТЯЖ*" Then
        p = "ПОЛЫ"

    End If

    Cells(2, 2) = p
    PS = PS + 1
End If

For i = 3 To PS
    t1 = Cells(i, 3)
    If t1 <> t Then
        Rows(i).Insert
        Range("A" & i & ":C" & i).Interior.ColorIndex = 15

        If t1 Like "*РАЗБОР*" Then
        p = "ДЕМОНТАЖНЫЕ РАБОТЫ"

    ElseIf t1 Like "*СТЕН*" Then
        p = "СТЕНЫ"

    ElseIf t1 Like "*СТЯЖ*" Then
        p = "ПОЛЫ"

    End If

        Cells(i, 2) = p
        PS = PS + 1
        t = t1
    End If
Next

End Sub

[/vba]

Сообщение отредактировал WowGun - Воскресенье, 05.11.2023, 21:07

Ответить

Gjlhzl

Дата: Понедельник, 06.11.2023, 09:12 | Сообщение № 3

Группа: Проверенные

Ранг: Форумчанин

Сообщений: 100

Репутация: 0 ±

Замечаний: 0% ±

WowGun, спасибо, работает!

Ответить

Страница 1 из 1
1