Добрый день, уважаемые знатоки VBA! Прошу помочь с макросом по удалению нужных строк в стандартном документе. В прикрепленном файле строки удаления выделил желтым. Есть нюанс - нужно оставить всю таблицу под названием "IV. Строительные материалы"... Но в названии римская цифра не постоянна, может быть V, а может быть VI, а слова const.
Спасибо.
Добрый день, уважаемые знатоки VBA! Прошу помочь с макросом по удалению нужных строк в стандартном документе. В прикрепленном файле строки удаления выделил желтым. Есть нюанс - нужно оставить всю таблицу под названием "IV. Строительные материалы"... Но в названии римская цифра не постоянна, может быть V, а может быть VI, а слова const.
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]
Здравствуйте. Решение "в лоб" [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
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
Pelena, спасибо большое - это действительно круто... Я мучился день, и только сумел верхние строчки удалить и все нижние, и макрос (без макрорекордера) получился на три км.
Спасибо еще раз.
Прошу пока тему не закрывать, оставлю для себя шанс что-либо у Вас спросить при необходимости.
Pelena, спасибо большое - это действительно круто... Я мучился день, и только сумел верхние строчки удалить и все нижние, и макрос (без макрорекордера) получился на три км.
Спасибо еще раз.
Прошу пока тему не закрывать, оставлю для себя шанс что-либо у Вас спросить при необходимости.grh1
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] то есть оставляю только верхнюю часть - код не работает - что не так я делаю?
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
почему спрашиваю - потому что выдает ошибку на последней строке кода .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
почему спрашиваю - потому что выдает ошибку на последней строке кода .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
эта строка работает, если в самой таблице прописано: № П.п. А в оригинале прописано № (Alt---Enter) П.п. то есть П.п. переносится через альт-энтер поэтому и вылетает ошибка.
Как прописать правильно № П.п. в коде???
Спасибо
P.S. такое если вставляю - ошибку выдает [vba]
Код
"№" & Chr(10) & "Ч.ч."
[/vba]
Я понял в чем дело. В макросе такая строка: [vba]
Код
Do While .Cells(i, 1) <> "№ П.п." And i > 1
[/vba]
эта строка работает, если в самой таблице прописано: № П.п. А в оригинале прописано № (Alt---Enter) П.п. то есть П.п. переносится через альт-энтер поэтому и вылетает ошибка.
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
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
Kuzmich, я где-то нарушил правила и меня Serge_007 сильно наказал - был % замечаний 20, а стал сразу 40%. Я не в претензии - заслужил значит заслужил. Но если можно, то ответьте пожалуйста на мой вопрос в теме "удаление объединенных строк" - если это не противоречит правилам. Если нельзя, то тогда не нужно.
Спасибо
Kuzmich, я пока не разобрался с Вашим вариантом. Удаляет Ваш макрос : 1. весь низ; 2. от шапки таблицы до строительных материалов;
Почему-то не удаляет первых три строки и шапку таблицы не урезает. Добавил две строчки (тоже снизу вверх):
Kuzmich, я где-то нарушил правила и меня Serge_007 сильно наказал - был % замечаний 20, а стал сразу 40%. Я не в претензии - заслужил значит заслужил. Но если можно, то ответьте пожалуйста на мой вопрос в теме "удаление объединенных строк" - если это не противоречит правилам. Если нельзя, то тогда не нужно.