макрос удалит на листе все строки, в которых содержится искомый текст:(пример - во вложении ConditionalRowsDeleting.xls) Sub УдалениеСтрокПоУсловию() Dim ra As Range, delra As Range, ТекстДляПоиска As String Application.ScreenUpdating = False ' отключаем обновление экрана ТекстДляПоиска = "Наименование ценности" ' удаляем строки с таким текстом ' перебираем все строки в используемом диапазоне листа For Each ra In ActiveSheet.UsedRange.Rows ' если в строке найден искомый текст If Not ra.Find(ТекстДляПоиска, , xlValues, xlPart) Is Nothing Then ' добавляем строку в диапазон для удаления If delra Is Nothing Then Set delra = ra Else Set delra = Union(delra, ra) End If Next ' если подходящие строки найдены - удаляем их If Not delra Is Nothing Then delra.EntireRow.Delete End Sub Чтобы вместо удаления просто скрыть такие строки, замените строку If Not delra Is Nothing Then delra.EntireRow.Delete на If Not delra Is Nothing Then delra.EntireRow.Hidden=TRUE Расширенная версия этого макроса - с использованием UserForm для ввода искомого значения (пример - в файле ConditionalRowsDeletingUsingUserform.xls) Function ПоискСтрокПоУсловию(ByVal ТекстДляПоиска As String, Optional HideOnly As Boolean) As Long ' функция получает в качестве параметра ТекстДляПоиска (можно использовать символы * и ?) ' Если HideOnly = TRUE, то строки, содержащие в ячейках ТекстДляПоиска, скрываются, ' иначе (HideOnly = FALSE - по умолчанию) - удаляются ' Функция возвращает количество удалённых строк Dim ra As Range, delra As Range Application.ScreenUpdating = False ' отключаем обновление экрана ' перебираем все строки в используемом диапазоне листа For Each ra In ActiveSheet.UsedRange.Rows ' если в строке найден искомый текст If Not ra.Find(ТекстДляПоиска, , xlValues, xlPart) Is Nothing Then ' добавляем строку в диапазон для удаления If delra Is Nothing Then Set delra = ra Else Set delra = Union(delra, ra) End If Next On Error Resume Next: ПоискСтрокПоУсловию = delra.Areas.Count ' количество найденных строк If Not delra Is Nothing Then ' если подходящие строки найдены - скрываем или удаляем их If HideOnly Then delra.EntireRow.Hidden = True Else delra.EntireRow.Delete End If End Function Ещё один вариант кода, позволяющего выполнять поиск (с последующим удалением или скрытием строк) сразу по нескольким условиям:Sub УдалениеСтрокПоНесколькимУсловиям() Dim ra As Range, delra As Range Application.ScreenUpdating = False ' отключаем обновление экрана ' ищем и удаляем строки, содержащие заданный текст ' (можно указать сколько угодно значений, и использовать подстановочные знаки) УдалятьСтрокиСТекстом = Array("Наименование *", "Количество", _ "текст?", "цен*сти", "*78*") ' перебираем все строки в используемом диапазоне листа For Each ra In ActiveSheet.UsedRange.Rows ' перебираем все фразы в массиве For Each word In УдалятьСтрокиСТекстом ' если в очередной строке листа найден искомый текст If Not ra.Find(word, , xlValues, xlPart) Is Nothing Then ' добавляем строку в диапазон для удаления If delra Is Nothing Then Set delra = ra Else Set delra = Union(delra, ra) End If Next word Next ' если подходящие строки найдены, то: (оставьте одну из 2 следующих строк) If Not delra Is Nothing Then delra.EntireRow.Hidden = True ' скрываем их If Not delra Is Nothing Then delra.EntireRow.Delete ' удаляем их End Sub
|
|||||||||
Комментарии
Дело в том, что для меня это как китайские письмена))
Здравствуйте, Сергей.
Конечно можно и UserForm прикрутить, и вообще что угодно.
Примеров в статье и комментах - предостаточно. Думаю, у вас без проблем получится всё это сделать.
Добрый день!
Для меня очень полезен макрос для удаления строк, не содержащих заданные текстовые строки (пост №10). Подскажите, можно ли к нему прикрутить UserForm для выбора значения поиска?
А как сделать чтобы поиск происходил только в одном столбце,
и скрывал все строки которые не имеют заданного текста
Спасибо
Xroute, макрос мой (да и вообще макросы) в этом случае не нужны.
Это очень просто делается при помощи простейших формул типа =если(), =И(), =СЧЁТЕСЛИ() и т.п.
Обратитесь на форум со своим файлом - вам помогут с формулами
(достаточно написать формулы для одной строки, а потом протянуть мышом эти формулы на нужное количество строк)
за основу взят Ваш макрос, таблица проста.
| Иванов | 1 | 0 | 4 | 6 | 15 | 11 | 5 | 14 | 0 |
только Вы удаляете строки, а мне надо пробежаться по таблице и в строках выявить совпадения из условий, условий допустим 3 или более. т.е если в строке, в какой-либо ячейки содержится число 4, то пишем в конец строки (14 ячейка) user, если в той же строке содержится число 1 - то пишем в 15 ячейку - megauser, и последнее, если в строке содержится и 5,11,14(порядок может быть любой, и они могут идти через 1 значение или в перемешку с другими, но компановка в строке 5,11,14 дает 1 значение) то пишем admin в 16 ячейку. грубо говоря в строке могут быть выполены все условия, а могут и не все. копи-пастом не вариант. слишком много строк. задача стоит именно в экселе, хотя на шарпе я это уже сделал, а вот в VB что-то не получается (
вот что должно получиться на выходе
| Иванов | 1 | 0 | 4 | 6 | 15 | 11 | 5 | 14 | 0 | | user | | Megauser | | Admin |
как-то так.
Спасибо.
Xroute, дублировать код макроса не надо.
Увы, подсказать, как именно лучше сделать, не могу, - не видя весь ваш код, сложно понять,
что именно вы хотите сделать.
Обратитесь на любой форум по Excel, прикрепив свой файл с кодом, - вам помогут.
Спасибо, очень помогли, но появился еще один, не менее глупый вопрос.
Можно делать вставку значений, в зависимости от переменной?
т.е
ver1 = Array("hello")
ver2 = Array("world")
и так далее, а потом форычем...но если честно - не получилось.
получилось в говнокоде, если каждый раз переназначать переменную и дублировать сам код макроса, а это не есть гут.
есть вариант скомпоновать и сделать красиво?
Спасибо.
Замените последнюю строку макроса на это:
If Not delra Is Nothing Then Intersect(delra.EntireRow, Columns(14)).value = "test"
А синтаксис у VB очень даже дружелюбный, если в нём разбираешься )
Спасибо за макрос.
Не подскажите, как сделать, чтоб строки не удалялись, а допустим в конец строки ( или конкретную 14 ячейку текущей строки, где было найдено совпадение) вставлялось значение "test".
VB увидел 1й раз, какой-то синтаксис не очень дружелюбный ((
Спасибо.
Добрый день!
Отличный макрос, но ещё необходимо что-бы он мог не только скрывать, но и раскрывать строки. И, желательно, иметь для этого пару кнопок в ленте. Это возможно?
Спасибо огромное за помощь!
Этот макрос переберёт все строки в заданном диапазоне, и скроет те из них, у которых ни одна ячейка не заполнена данными:
Dim ro As Range, delra As Range
Application.ScreenUpdating = False ' отключаем обновление экрана
' перебираем все строки в диапазоне с 1-й по 150-ю
For Each ro In Range("1:150").EntireRow
' если в строке НЕ найден любой текст
If ro.Find("*", , xlValues, xlPart) Is Nothing Then
If delra Is Nothing Then Set delra = ro Else Set delra = Union(delra, ro)
End If
Next
' если подходящие строки найдены - удаляем их
If Not delra Is Nothing Then delra.EntireRow.Hidden = True
End Sub
Подскажите, пожалуйста, какие изменения нужно внести в ваш макрос для скрытия просто пустых строк в диапазоне от 1 до 150 строки.
А как адаптировать Ваш макрос для ячейки с условием, например удалять строку если в ячейке значение больше, например, нуля?
уже все работает)
Не знаю, что вы там делаете, но строка "If ws.Index = 1 Then" явно не из моего макроса
(в моем макросе нет переменной ws)
Вот если вы показали бы полный код своего макроса - тогда можно было бы сказать, в чем именно ошибка.
У меня не удаляет ничего( Что я делаю не правильно?
удалять только на первом листе, который называется "накладная"
If ws.Index = 1 Then
Правильно?
Спасибо!!! Все работает как нужно - с Вашей помощью.
А вы попробуйте сначала удалить нули из ячеек
А потом удаляйте строки с пустыми ячейками:
Или можете использовать функцию поиска всех заданных значений:
FindAll(ws.Columns(4), "0").EntireRow.Delete
Просмотрел много форумов по удалению строк через макрос. Нашел один который частично подходит мне, он удаляет строки если в 5 столбце пусто во всех листах кроме первого. Но не знаю как добавить, чтоб удалял еще и строки если в 4 столбце значение 0. Код быстрый (без цикла) а как дополнить - ума не приложу...
Sub DeleteEmptyRowsToAll()
Application.ScreenUpdating = False ' отключаем обновление экрана
On Error Resume Next
Dim ws As Worksheet 'декларирование переменой
For Each ws In Worksheets
If ws.Index > 1 Then ' кроме первого листа
ws.Columns(5).SpecialCells(xlCellTypeBlanks).EntireRow.Delete ' удаляем сразу все строки, в которых в 5-м столбце - пусто
End If
Next
End Sub
Заранее благодарю
Огромное спасибо за помощь!!! :)
Про чёрные ячейки в столбце...
Файл обновляется несколько раз в день - делать выборку вручную не вариант, нужен макрос.
А офис 2007 покупать шеф не хочет - 18 компов... Хватит вам и 2003, тем более официальный.
Про форум - пардон, не так назвал. Извините, если обидел.
Используйте фильтр по цвету (он доступен в Excel 2007 и выше): скройте все чёрные ячейки в столбце, после чего удалите видимые строки, и отключите фильтрацию.
Всё быстро и просто - и никаких макросов.
PS: Про какой форум речь? У меня на сайте форума нет, и не предвидится в ближайшем будущем...
Очень хороший форум! Часто им пользуюсь, а вот теперь забуксовал.
задача: имеется таблица, в которой, например, третий из столбец заполнен по принципу - или черная или белая ячейка. Нужно удалить строки с белыми ячейками в этом столбце. Заранее спасибо!
Вовсе необязательно вкладывать 3 условия в макрос.
Я бы на вашем месте в дополнительные столбец поместил формулу типа такой:
=ЕСЛИ(ИЛИ(Q1<5;НЕ(ЕОШ(НАЙТИ("текст";I1;1)));И(СЧЁТЕСЛИ(L:L;L1)=1;Q1>2));"";"не удаляем")
И потом бы макросом (или через автофильтр) удалил пустые строки по доп.столбцу
Добрый день, подскажите как написать макрос для скрытия и открытия (Или удаления) строк таблицы если в диапазоне ячеек [Пример:(d5:g100)] строка содержит в ячейках нули (или формулу, но отображает по формуле ноль)
Это как раз то что я так долго искал! Большое спасибо за информацию!
Помогите пожалуйста решить чуть более сложную задачу.
Есть несколько условий для удаления,
1) если значение ячейки (числовое) в столбце "Q" меньше "число" - удаляем строку
2) если значение ячейки (текстовое) в столбце "I" содержит "текст" - удаляем строку
И самое, наверное сложное:
3) если значение ячейки (текстовое) в столбце "L" встречается на листе только 1 раз и при этом значение ячейки (числовое) в столбце "Q" больше "число" - удаляем строку
И как все эти условия правильно в циклы вложить
PS В файле больше 30000 строк
Заранее спасибо! С уважением!
Большое спасибо за помощь! Работает!
Чтобы обработка ячеек начиналась с 15-строки, надо изменить анализируемый диапазон:
вместо
написать
Т.е. поиск будет производится на пересечении используемого диапазона листа, и диапазона строк с 15-й по последнюю строку листа
(таким образом мы отсекаем первые 14 строк)
Кир Булычев, причину такого поведения вашего макроса я не знаю.
Надо смотреть файл - возможно, проблема в нём.
И, кстати, для 10000 строк надо использовать другие, более правильные и быстрые, алгоритмы
(хотя бы потому, что Union работает медленно, и не может вмещать в себя более 1000 ячеек. Т.е. если у вас с нулями и единицами будет 1500 строк, - то удалится только около 1000 строк, остальные макрос пропустит)
PS: За помощью лучше обращайтесь на форумы по Excel
(я помогаю не бесплатно)
День добрый !
Вот пользовался макросом который Вы посоветовали (я заменил только локацию данных):
Sub УдалениеСтрокСТремяЗначениями()
' удаляются части строк, в кторых в столбце "O" находится 0, 1 или #N/A
On Error Resume Next
Dim cell As Range, delra As Range: Application.ScreenUpdating = False
For Each cell In Range("O:O").SpecialCells(xlCellTypeConstants)
If Val(cell) = 0 Or Val(cell) = 1 Then
If delra Is Nothing Then Set delra = cell Else Set delra = Union(delra, cell)
End If
Next cell
If Not delra Is Nothing Then Intersect(delra.EntireRow, Range("M:O")).Delete
Intersect(Range("O:O").SpecialCells(xlCellTypeConstants, xlErrors).EntireRow, Range("M:O")).Delete
- но вот недавно, увеличилось число обрабатываемых данных (со 180 до 380 строк, а будет и до 10 000) и если раньше макрос удалял данные в строках с "М" по "О" если в "О" содержатся "1", "0" или "N/A" и поднимал их вверх (т.е. удалял строки) - то теперь он также удаляет данные НО стирает не строки а 2 соседних столбца справа. При возврате к меньшему кол-ву обрабатываемых ячеек/данных - всё снова работает нормально.
Решил опять к Вам обратится за помощью т.к. составные этого макроса к сожалению находятся за граню моих познаний в VBA.
Буду очень благодарен если посоветуете что-нибудь.
Скажите, пжта, если надо начать рассматривать массив начиная допустим с 15-й строки. Какие изменения претерпит макрос?
Здравствуйте !
У меня вопрос по макросу "позволяющему выполнять поиск (с последующим удалением или скрытием строк) сразу по нескольким условиям:"
Мне нужно чтоб удалялись строки со значением НОЛЬ.
Ставлю "0" и удаляются все значения в значении которого есть НОЛЬ.
Как сделать что бы такого не происходила! Сохранив при этом удаление по нескольким условиям.
А можно как-то сделать так, чтобы этот макрос всегда был включен при заходе в файл Exela и работал динамически. К примеру, если поменяются данные в ячейках C2:CI2, то сразу скроются или отобразяться ячейки согласно макросу.
Вы правы!!! Спасибо большое, он работает хорошо! У меня неполучилось потому что я буквы ставил в ячейки, если подставить цифры то все будет работать правильно :)
Неужели? Плохо проверяли...
Этому макросу нет разницы, что в ячейках - формулы или значения.
Вот вам файл с формулами и этим макросом для проверки:
http://excelvba.ru/XL_Files/Sample__11-10-2011__14-46-12.zip
Sub СкрываемПустыеСтолбцы()
Dim cell As Range: Application.ScreenUpdating = False
For Each cell In [c2:ci2].Cells
' скрываем столбцы, если в ячейке ноль или пусто
cell.EntireColumn.Hidden = Val(cell) = 0
Next cell
End Sub
Спасибо большое за данный макрос, но он не совсем работает так как мне нужно, я проверил его и окозалось что он опознает ячейки только с введенными данными в ручную, а формулы он не распознает. Допиши пожалуйста макрос, который сможет определять данный полученные формулами в этих ячейках.
Моя задача решена. Спасибо огромное))) В целом - действовала по предложенному Вами плану))) Спасибо!)))))
В макросе в выражении ra.Find(word, , xlValues, xlPart) есть опция xlValues - она отвечает за поиск В ЗНАЧЕНИЯХ.
Есть и другие варианты этой опции:
xlFormulas - поиск в формулах
xlComments - поиск в комментариях к ячейке
Спасибо большое за данный макрос, но он не совсем работает так как мне нужно, я проверил его и окозалось что он опознает ячейки только с введенными данными в ручную, а формулы он не распознает. Допиши пожалуйста макрос, который сможет определять данный полученные формулами в этих ячейках.
Как бы для меня очень затруднительным получается п.3...((((
Т.е. создать бегунок по строкам (нахожу совпадение - копирую) нереально?(((((
Здравствуйте, Ольга.
Тут многое зависит от того, насколько "огромный" ваш файл (тысячи, десятки или сотни тысяч, миллион строк?)
При разных объёмах данных - разные алгоритмы.
Представленный мной код корректно работает для небольших таблиц (где число скрываемых\удаляемых строк не превышает тысячи)
Это ограничение легко обойти, но для увеличения производительности необходимо полностью изменить алгоритм макроса
(что моментально работает на тысячах строк, может нещадно тормозить на миллионе строк)
Самый простой способ, который приходит мне на ум - с использованием формулы в доп.столбце:
1) на отдельном листе делаем список из 50 позиций
2) в дополнительном (пустом) столбце с огромной таблицей пишем формулу, которая проверяет наличие одного из 50 слов в строке
3) применяем автофильтр в этому доп. столбцу, оставляя видимыми лишь те строки, для которых формула вернула результат "совпадение найдено"
4) выделяем и копируем видимые строки на другой лист
Подскажите, пожалуйста, как можно решить такую задачу:
В документе Excel нужно организовать поиск: сразу искать по 50 позиций (огромный файл нужен быстрый поиск по огромному кол-ву материалов)и выводить на новый лист уже найденные позиции и все, что соответствует этим позициям в строке (например, найти среди строительных материалов песок, гравий и т.д. и вывести вместе с количеством на новый лист). Даже не знаю, как лучше эти 50 позиций для поиска делать: лучше бы через UserForm, но пока не получается((((
Буду признательна за любую помощь.
Спасибо)
Вам поможет такой макрос:
(не самый быстрый - но экономить миллисекунды не вижу смысла)
Dim cell As Range: Application.ScreenUpdating = False
For Each cell In [c2:ci2].Cells
' скрываем столбцы, если в ячейке ноль или пусто
cell.EntireColumn.Hidden = Val(cell) = 0
Next cell
End Sub
Автор помогите пожалуйста с решением данной задачи!!! Уже давно пытаюсь в интернете решить этот вопрос, никак не получается.
У меня есть таблица, которая состоит из строки (2) и столбцов (C:CI), в столбцах с помощью формул отображаются данные с числами и нулями или пустыми ячейками. Так как таблица с вводом новых значений в формулы постоянно меняет расположение пустых ячеек и нулей в данной строке (2) со столбцами (C:CI), то мне нужно автоматически скрывать все пустые ячейки или ячейки с нулями, а все ячейки с числами в строке (2), столбцы (C:CI) раскрывать. Помогите пожалуйста решить этот вопрос.
Огромное спасибо !
Теперь макрос короче и работает в два раза быстрее !
Очень признателен вам за помощь.
Попробуйте такой макрос:
' удаляются части строк, в кторых в столбце J находится 0, 1 или #N/A
On Error Resume Next
Dim cell As Range, delra As Range: Application.ScreenUpdating = False
For Each cell In Range("J:J").SpecialCells(xlCellTypeFormulas)
If Val(cell) = 0 Or Val(cell) = 1 Then
If delra Is Nothing Then Set delra = cell Else Set delra = Union(delra, cell)
End If
Next cell
If Not delra Is Nothing Then Intersect(delra.EntireRow, Range("G:L")).Delete
Intersect(Range("J:J").SpecialCells(xlCellTypeFormulas, xlErrors).EntireRow, Range("G:L")).Delete
End Sub
Большое спасибо за ответ.
Я правда не указал, что в в столбце "J" ищу 3 значения для удаления - "#N/A", "0", "1". ( Думал своим умом дойду :) ). В результате в моём полном макросе 3 раза повторяется указанный мною макрос (чтобы удалить каждое значение).
В моей таблице с "G" по "L" указано название товара, а конкретно в "L" его наличие.
С помощью вашего совета я смогу убить лишь одного из своих трёх зайцев :(
Посоветуйте пожалуйста как модернизировать макрос для постоянных величин ( например "1")
Заранее благодарен.
В вашем случае можно использовать гораздо более простой и быстрый макрос:
Intersect(Range("J:J").SpecialCells(xlCellTypeFormulas, xlErrors).EntireRow, Range("G:L")).Delete
End Sub
Этот код найдёт в столбце G активного листа ВСЕ ячейки с формулами, возвращающими ошибку (не только ошибку #N/A - но и любую другую),
после чего из найденных строк удалит ячейки столбцов G:L (со сдвигом вверх)
PS: Если у вас на листе не формулы, а значения с ошибками (результаты вычисления вставлены "как значения"),
замените в коде константу xlCellTypeFormulas на xlCellTypeConstants
Отправить комментарий