Домашняя страница Undo Do New Save Карта сайта Обратная связь Поиск по форуму
МИР MS EXCEL - Гость.xls

Вход

Регистрация

Напомнить пароль

 

= Мир MS Excel/удаление нужных строк - Мир MS Excel

Старая форма входа
  • Страница 1 из 1
  • 1
Модератор форума: китин, _Boroda_  
удаление нужных строк
grh1 Дата: Вторник, 30.08.2022, 18:53 | Сообщение № 1
Группа: Проверенные
Ранг: Форумчанин
Сообщений: 233
Репутация: 0 ±
Замечаний: 40% ±

2019
Добрый день, уважаемые знатоки VBA!
Прошу помочь с макросом по удалению нужных строк в стандартном документе.
В прикрепленном файле строки удаления выделил желтым.
Есть нюанс - нужно оставить всю таблицу под названием "IV. Строительные материалы"...
Но в названии римская цифра не постоянна, может быть V, а может быть VI, а слова const.

Спасибо.

К сообщению приложен файл: _1.xlsm (43.7 Kb)


Vadym Gorokh
 
Ответить
СообщениеДобрый день, уважаемые знатоки VBA!
Прошу помочь с макросом по удалению нужных строк в стандартном документе.
В прикрепленном файле строки удаления выделил желтым.
Есть нюанс - нужно оставить всю таблицу под названием "IV. Строительные материалы"...
Но в названии римская цифра не постоянна, может быть V, а может быть VI, а слова const.

Спасибо.


Автор - grh1
Дата добавления - 30.08.2022 в 18:53
Pelena Дата: Вторник, 30.08.2022, 21:25 | Сообщение № 2
Группа: Админы
Ранг: Местный житель
Сообщений: 19403
Репутация: 4555 ±
Замечаний: ±

Excel 365 & Mac Excel
Здравствуйте.
Решение "в лоб"
[vba]
Код
Public Sub DelRows()
    Dim sh As Worksheet, KeyWords, rng As Range, lrow As Long, i As Long
    Set sh = ActiveSheet
    With sh
        lrow = .UsedRange.Row + .UsedRange.Rows.Count - 1
        i = lrow
        Do While .Cells(i, 1) <> "Итоговые показатели" And i > 1
            i = i - 1
        Loop
        .Rows("" & i & ":" & lrow & "").Delete
        Do While Not .Cells(i, 1) Like "*Строительные материалы" And i > 1
            i = i - 1
        Loop
        lrow = i - 1
        Do While .Cells(i, 1) <> "№ П.п." And i > 1
            i = i - 1
        Loop
        .Rows("" & i + 2 & ":" & lrow & "").Delete
        Do While .Cells(i, 1) <> "Ведомость материалов" And i > 1
            i = i - 1
        Loop
        .Rows("1:" & i - 1 & "").Delete
    End With
End Sub
[/vba]
К сообщению приложен файл: _1-2-.xlsm (47.2 Kb)


"Черт возьми, Холмс! Но как??!!"
Ю-money 41001765434816
 
Ответить
СообщениеЗдравствуйте.
Решение "в лоб"
[vba]
Код
Public Sub DelRows()
    Dim sh As Worksheet, KeyWords, rng As Range, lrow As Long, i As Long
    Set sh = ActiveSheet
    With sh
        lrow = .UsedRange.Row + .UsedRange.Rows.Count - 1
        i = lrow
        Do While .Cells(i, 1) <> "Итоговые показатели" And i > 1
            i = i - 1
        Loop
        .Rows("" & i & ":" & lrow & "").Delete
        Do While Not .Cells(i, 1) Like "*Строительные материалы" And i > 1
            i = i - 1
        Loop
        lrow = i - 1
        Do While .Cells(i, 1) <> "№ П.п." And i > 1
            i = i - 1
        Loop
        .Rows("" & i + 2 & ":" & lrow & "").Delete
        Do While .Cells(i, 1) <> "Ведомость материалов" And i > 1
            i = i - 1
        Loop
        .Rows("1:" & i - 1 & "").Delete
    End With
End Sub
[/vba]

Автор - Pelena
Дата добавления - 30.08.2022 в 21:25
Kuzmich Дата: Вторник, 30.08.2022, 21:32 | Сообщение № 3
Группа: Проверенные
Ранг: Ветеран
Сообщений: 713
Репутация: 157 ±
Замечаний: 0% ±

Excel 2003
Цитата
строки удаления выделил желтым

[vba]
Код
Sub iRowsDelete()
Dim FoundCell As Range
Dim iRow_1 As Long
Dim iRow_2 As Long
Dim iLastRow As Long
    iLastRow = Cells(Rows.Count, "D").End(xlUp).Row
  Set FoundCell = Columns("A:J").Find("Строительные материалы", , xlValues, xlPart)
  iRow_1 = FoundCell.Row
    Set FoundCell = Columns("A:J").Find("Итоговые показатели", , xlValues, xlPart)
  iRow_2 = FoundCell.Row
    Rows(iRow_2 & ":" & iLastRow).Delete
    Rows("10:" & iRow_1 - 1).Delete
End Sub
[/vba]
 
Ответить
Сообщение
Цитата
строки удаления выделил желтым

[vba]
Код
Sub iRowsDelete()
Dim FoundCell As Range
Dim iRow_1 As Long
Dim iRow_2 As Long
Dim iLastRow As Long
    iLastRow = Cells(Rows.Count, "D").End(xlUp).Row
  Set FoundCell = Columns("A:J").Find("Строительные материалы", , xlValues, xlPart)
  iRow_1 = FoundCell.Row
    Set FoundCell = Columns("A:J").Find("Итоговые показатели", , xlValues, xlPart)
  iRow_2 = FoundCell.Row
    Rows(iRow_2 & ":" & iLastRow).Delete
    Rows("10:" & iRow_1 - 1).Delete
End Sub
[/vba]

Автор - Kuzmich
Дата добавления - 30.08.2022 в 21:32
grh1 Дата: Вторник, 30.08.2022, 21:36 | Сообщение № 4
Группа: Проверенные
Ранг: Форумчанин
Сообщений: 233
Репутация: 0 ±
Замечаний: 40% ±

2019
Pelena, спасибо большое - это действительно круто...
Я мучился день, и только сумел верхние строчки удалить и все нижние, и макрос (без макрорекордера) получился на три км.

Спасибо еще раз.

Прошу пока тему не закрывать, оставлю для себя шанс что-либо у Вас спросить при необходимости.


Vadym Gorokh
 
Ответить
СообщениеPelena, спасибо большое - это действительно круто...
Я мучился день, и только сумел верхние строчки удалить и все нижние, и макрос (без макрорекордера) получился на три км.

Спасибо еще раз.

Прошу пока тему не закрывать, оставлю для себя шанс что-либо у Вас спросить при необходимости.

Автор - grh1
Дата добавления - 30.08.2022 в 21:36
grh1 Дата: Вторник, 30.08.2022, 22:15 | Сообщение № 5
Группа: Проверенные
Ранг: Форумчанин
Сообщений: 233
Репутация: 0 ±
Замечаний: 40% ±

2019
Pelena, такой вопрос
если я оставляю строки Вашего кода
[vba]
Код
Public Sub DelRows()    
    Dim sh As Worksheet, KeyWords, rng As Range, lrow As Long, i As Long    
    Set sh = ActiveSheet    
    With sh    
    Do While .Cells(i, 1) <> "Ведомость материалов" And i > 1
             i = i - 1
         Loop
         .Rows("1:" & i - 1 & "").Delete
     End With
End Sub
[/vba]
то есть оставляю только верхнюю часть - код не работает - что не так я делаю?


Vadym Gorokh
 
Ответить
СообщениеPelena, такой вопрос
если я оставляю строки Вашего кода
[vba]
Код
Public Sub DelRows()    
    Dim sh As Worksheet, KeyWords, rng As Range, lrow As Long, i As Long    
    Set sh = ActiveSheet    
    With sh    
    Do While .Cells(i, 1) <> "Ведомость материалов" And i > 1
             i = i - 1
         Loop
         .Rows("1:" & i - 1 & "").Delete
     End With
End Sub
[/vba]
то есть оставляю только верхнюю часть - код не работает - что не так я делаю?

Автор - grh1
Дата добавления - 30.08.2022 в 22:15
grh1 Дата: Вторник, 30.08.2022, 23:36 | Сообщение № 6
Группа: Проверенные
Ранг: Форумчанин
Сообщений: 233
Репутация: 0 ±
Замечаний: 40% ±

2019
почему спрашиваю - потому что выдает ошибку на последней строке кода
[vba]
Код
.Rows("1:" & i - 1 & "").Delete
[/vba]

Что может быть? Файл прилагаю
К сообщению приложен файл: _3.xlsm (44.0 Kb)


Vadym Gorokh
 
Ответить
Сообщениепочему спрашиваю - потому что выдает ошибку на последней строке кода
[vba]
Код
.Rows("1:" & i - 1 & "").Delete
[/vba]

Что может быть? Файл прилагаю

Автор - grh1
Дата добавления - 30.08.2022 в 23:36
Pelena Дата: Среда, 31.08.2022, 00:08 | Сообщение № 7
Группа: Админы
Ранг: Местный житель
Сообщений: 19403
Репутация: 4555 ±
Замечаний: ±

Excel 365 & Mac Excel
оставляю только верхнюю часть - код не работает

а зачем Вы это делаете?


"Черт возьми, Холмс! Но как??!!"
Ю-money 41001765434816
 
Ответить
Сообщение
оставляю только верхнюю часть - код не работает

а зачем Вы это делаете?

Автор - Pelena
Дата добавления - 31.08.2022 в 00:08
grh1 Дата: Среда, 31.08.2022, 06:53 | Сообщение № 8
Группа: Проверенные
Ранг: Форумчанин
Сообщений: 233
Репутация: 0 ±
Замечаний: 40% ±

2019
а зачем Вы это делаете?

Так в предыдущем посте ответил:

почему спрашиваю - потому что выдает ошибку на последней строке кода
.Rows("1:" & i - 1 & "").Delete

Имеется ввиду ВСЕГО Вашего кода, т.е.

[vba]
Код
Public Sub DelRows()
    Dim sh As Worksheet, KeyWords, rng As Range, lrow As Long, i As Long
    Set sh = ActiveSheet
    With sh
        lrow = .UsedRange.Row + .UsedRange.Rows.Count - 1
        i = lrow
        Do While .Cells(i, 1) <> "Итоговые показатели" And i > 1
            i = i - 1
        Loop
        .Rows("" & i & ":" & lrow & "").Delete
        Do While Not .Cells(i, 1) Like "*Строительные материалы" And i > 1
            i = i - 1
        Loop
        lrow = i - 1
        Do While .Cells(i, 1) <> "№ П.п." And i > 1
            i = i - 1
        Loop
        .Rows("" & i + 2 & ":" & lrow & "").Delete
        Do While .Cells(i, 1) <> "Ведомость материалов" And i > 1
            i = i - 1
        Loop
        .Rows("1:" & i - 1 & "").Delete
    End With
End Sub
[/vba]
и поэтому прикрепил файл. ,


Vadym Gorokh
 
Ответить
Сообщение
а зачем Вы это делаете?

Так в предыдущем посте ответил:

почему спрашиваю - потому что выдает ошибку на последней строке кода
.Rows("1:" & i - 1 & "").Delete

Имеется ввиду ВСЕГО Вашего кода, т.е.

[vba]
Код
Public Sub DelRows()
    Dim sh As Worksheet, KeyWords, rng As Range, lrow As Long, i As Long
    Set sh = ActiveSheet
    With sh
        lrow = .UsedRange.Row + .UsedRange.Rows.Count - 1
        i = lrow
        Do While .Cells(i, 1) <> "Итоговые показатели" And i > 1
            i = i - 1
        Loop
        .Rows("" & i & ":" & lrow & "").Delete
        Do While Not .Cells(i, 1) Like "*Строительные материалы" And i > 1
            i = i - 1
        Loop
        lrow = i - 1
        Do While .Cells(i, 1) <> "№ П.п." And i > 1
            i = i - 1
        Loop
        .Rows("" & i + 2 & ":" & lrow & "").Delete
        Do While .Cells(i, 1) <> "Ведомость материалов" And i > 1
            i = i - 1
        Loop
        .Rows("1:" & i - 1 & "").Delete
    End With
End Sub
[/vba]
и поэтому прикрепил файл. ,

Автор - grh1
Дата добавления - 31.08.2022 в 06:53
grh1 Дата: Среда, 31.08.2022, 08:02 | Сообщение № 9
Группа: Проверенные
Ранг: Форумчанин
Сообщений: 233
Репутация: 0 ±
Замечаний: 40% ±

2019
Я понял в чем дело.
В макросе такая строка:
[vba]
Код
Do While .Cells(i, 1) <> "№ П.п." And i > 1
[/vba]

эта строка работает, если в самой таблице прописано: № П.п.
А в оригинале прописано № (Alt---Enter) П.п. то есть П.п. переносится через альт-энтер
поэтому и вылетает ошибка.

Как прописать правильно № П.п. в коде???

Спасибо

P.S. такое если вставляю - ошибку выдает [vba]
Код
"№" & Chr(10) & "Ч.ч."
[/vba]


Vadym Gorokh

Сообщение отредактировал grh1 - Среда, 31.08.2022, 08:21
 
Ответить
СообщениеЯ понял в чем дело.
В макросе такая строка:
[vba]
Код
Do While .Cells(i, 1) <> "№ П.п." And i > 1
[/vba]

эта строка работает, если в самой таблице прописано: № П.п.
А в оригинале прописано № (Alt---Enter) П.п. то есть П.п. переносится через альт-энтер
поэтому и вылетает ошибка.

Как прописать правильно № П.п. в коде???

Спасибо

P.S. такое если вставляю - ошибку выдает [vba]
Код
"№" & Chr(10) & "Ч.ч."
[/vba]

Автор - grh1
Дата добавления - 31.08.2022 в 08:02
Pelena Дата: Среда, 31.08.2022, 08:07 | Сообщение № 10
Группа: Админы
Ранг: Местный житель
Сообщений: 19403
Репутация: 4555 ±
Замечаний: ±

Excel 365 & Mac Excel
Как прописать правильно № П.п. в коде?

так попробуйте
[vba]
Код
Public Sub DelRows()
    Dim sh As Worksheet, KeyWords, rng As Range, lrow As Long, i As Long
    Set sh = ActiveSheet
    With sh
        lrow = .UsedRange.Row + .UsedRange.Rows.Count - 1
        i = lrow
        Do While .Cells(i, 1) <> "Итоговые показатели" And i > 1
            i = i - 1
        Loop
        .Rows("" & i & ":" & lrow & "").Delete
        Do While Not .Cells(i, 1) Like "*Строительные материалы" And i > 1
            i = i - 1
        Loop
        lrow = i - 1
        Do While Not .Cells(i, 1) Like "№*П.п." And i > 1
            i = i - 1
        Loop
        .Rows("" & i + 2 & ":" & lrow & "").Delete
        Do While .Cells(i, 1) <> "Ведомость материалов" And i > 1
            i = i - 1
        Loop
        .Rows("1:" & i - 1 & "").Delete
    End With
End Sub
[/vba]


"Черт возьми, Холмс! Но как??!!"
Ю-money 41001765434816
 
Ответить
Сообщение
Как прописать правильно № П.п. в коде?

так попробуйте
[vba]
Код
Public Sub DelRows()
    Dim sh As Worksheet, KeyWords, rng As Range, lrow As Long, i As Long
    Set sh = ActiveSheet
    With sh
        lrow = .UsedRange.Row + .UsedRange.Rows.Count - 1
        i = lrow
        Do While .Cells(i, 1) <> "Итоговые показатели" And i > 1
            i = i - 1
        Loop
        .Rows("" & i & ":" & lrow & "").Delete
        Do While Not .Cells(i, 1) Like "*Строительные материалы" And i > 1
            i = i - 1
        Loop
        lrow = i - 1
        Do While Not .Cells(i, 1) Like "№*П.п." And i > 1
            i = i - 1
        Loop
        .Rows("" & i + 2 & ":" & lrow & "").Delete
        Do While .Cells(i, 1) <> "Ведомость материалов" And i > 1
            i = i - 1
        Loop
        .Rows("1:" & i - 1 & "").Delete
    End With
End Sub
[/vba]

Автор - Pelena
Дата добавления - 31.08.2022 в 08:07
grh1 Дата: Среда, 31.08.2022, 08:55 | Сообщение № 11
Группа: Проверенные
Ранг: Форумчанин
Сообщений: 233
Репутация: 0 ±
Замечаний: 40% ±

2019
варианты, при которых выдает ошибку:
- "№" & Chr(10) & "П.п."
- "№ & Chr(10) & П.п."
- "№*П.п."
- "№ * П.п."

Что можно еще попробовать?


Vadym Gorokh
 
Ответить
Сообщениеварианты, при которых выдает ошибку:
- "№" & Chr(10) & "П.п."
- "№ & Chr(10) & П.п."
- "№*П.п."
- "№ * П.п."

Что можно еще попробовать?

Автор - grh1
Дата добавления - 31.08.2022 в 08:55
Pelena Дата: Среда, 31.08.2022, 08:56 | Сообщение № 12
Группа: Админы
Ранг: Местный житель
Сообщений: 19403
Репутация: 4555 ±
Замечаний: ±

Excel 365 & Mac Excel
№*П.п.

у меня этот вариант отработал в приложенном файле. Или уже в другом файле ошибка?


"Черт возьми, Холмс! Но как??!!"
Ю-money 41001765434816
 
Ответить
Сообщение
№*П.п.

у меня этот вариант отработал в приложенном файле. Или уже в другом файле ошибка?

Автор - Pelena
Дата добавления - 31.08.2022 в 08:56
grh1 Дата: Среда, 31.08.2022, 09:16 | Сообщение № 13
Группа: Проверенные
Ранг: Форумчанин
Сообщений: 233
Репутация: 0 ±
Замечаний: 40% ±

2019
Pelena, да отработал, только не
[vba]
Код
.Rows("" & i + 2 & ":" & lrow & "").Delete
[/vba]

а заменить на
[vba]
Код
.Rows("" & i + 1 & ":" & lrow & "").Delete
[/vba]

Всё работает спасибо.


Vadym Gorokh
 
Ответить
СообщениеPelena, да отработал, только не
[vba]
Код
.Rows("" & i + 2 & ":" & lrow & "").Delete
[/vba]

а заменить на
[vba]
Код
.Rows("" & i + 1 & ":" & lrow & "").Delete
[/vba]

Всё работает спасибо.

Автор - grh1
Дата добавления - 31.08.2022 в 09:16
Kuzmich Дата: Среда, 31.08.2022, 11:29 | Сообщение № 14
Группа: Проверенные
Ранг: Ветеран
Сообщений: 713
Репутация: 157 ±
Замечаний: 0% ±

Excel 2003
grh1, а что мой вариант вам не подошел?
 
Ответить
Сообщениеgrh1, а что мой вариант вам не подошел?

Автор - Kuzmich
Дата добавления - 31.08.2022 в 11:29
grh1 Дата: Среда, 31.08.2022, 16:09 | Сообщение № 15
Группа: Проверенные
Ранг: Форумчанин
Сообщений: 233
Репутация: 0 ±
Замечаний: 40% ±

2019
Kuzmich, я пока не разобрался с Вашим вариантом.
Удаляет Ваш макрос :
1. весь низ;
2. от шапки таблицы до строительных материалов;

Почему-то не удаляет первых три строки и шапку таблицы не урезает.
Добавил две строчки (тоже снизу вверх):

[vba]
Код

    Rows("7:9").Delete shift:=xlUp
    Rows("1:3").Delete shift:=xlUp
[/vba]

И всё работает как часы.

Kuzmich, я где-то нарушил правила и меня Serge_007 сильно наказал - был % замечаний 20, а стал сразу 40%.
Я не в претензии - заслужил значит заслужил.
Но если можно, то ответьте пожалуйста на мой вопрос в теме "удаление объединенных строк" - если это не противоречит правилам.
Если нельзя, то тогда не нужно.

Спасибо


Vadym Gorokh

Сообщение отредактировал grh1 - Среда, 31.08.2022, 16:16
 
Ответить
СообщениеKuzmich, я пока не разобрался с Вашим вариантом.
Удаляет Ваш макрос :
1. весь низ;
2. от шапки таблицы до строительных материалов;

Почему-то не удаляет первых три строки и шапку таблицы не урезает.
Добавил две строчки (тоже снизу вверх):

[vba]
Код

    Rows("7:9").Delete shift:=xlUp
    Rows("1:3").Delete shift:=xlUp
[/vba]

И всё работает как часы.

Kuzmich, я где-то нарушил правила и меня Serge_007 сильно наказал - был % замечаний 20, а стал сразу 40%.
Я не в претензии - заслужил значит заслужил.
Но если можно, то ответьте пожалуйста на мой вопрос в теме "удаление объединенных строк" - если это не противоречит правилам.
Если нельзя, то тогда не нужно.

Спасибо

Автор - grh1
Дата добавления - 31.08.2022 в 16:09
  • Страница 1 из 1
  • 1
Поиск:

Яндекс.Метрика Яндекс цитирования
© 2010-2024 · Дизайн: MichaelCH · Хостинг от uCoz · При использовании материалов сайта, ссылка на www.excelworld.ru обязательна!