Excel vba удаление строк умной таблицы
Предположу, что почти каждый сталкивался с ситуацией, когда необходимо удалить только определенные строки: имеется большая таблица и необходимо удалить из неё только те строки, которые содержат какое-то слово (цифру, фразу). Для выполнения подобной задачи можно воспользоваться несколькими способами.
Способ первый:
Использовать встроенное средство Excel - фильтр. Сначала его необходимо "установить" на листе:
- Выделяем таблицу с данными, включая заголовки. Если их нет - то выделяем с самой первой строки таблицы, в которой необходимо удалить данные
- устанавливаем фильтр:
- для Excel 2003 : Данные-Фильтр-Автофильтр
- для Excel 2007-2010 : вкладка Данные (Data) -Фильтр (Filter)(или вкладка Главная (Home) -Сортировка и фильтр (Sort&Filter) -Фильтр (Filter) )
Теперь выбираем условие для фильтра:
- в Excel 2003 надо выбрать Условие и в появившейся форме выбрать непосредственно условие("равно", "содержит", "начинается с" и т.д.), а напротив значение в соответствии с условием.
- Для 2007-2010 Excel нужно выбрать Текстовые фильтры (Text Filters) и либо сразу выбрать одно из предлагаемых условий, либо нажать Настраиваемый фильтр (Custom Filter) и ввести значения для отбора в форме
После этого удалить отфильтрованные строки. В 2007 Excel могут возникнуть проблемы с удалением отфильтрованных строк, поэтому рекомендую сначала так же прочитать статью: Excel удаляет вместо отфильтрованных строк - все?! Как избежать.
Способ второй:
применить код VBA, который потребует только указания значения, которое необходимо найти в строке и номер столбца, в котором искать значение.Если значение sSubStr не будет указано, то будут удалены строки, ячейки указанного столбца которых, пустые.
Данный код необходимо поместить в стандартный модуль. Вызвать с листа его можно нажатием клавиш Alt + F8 , после чего выбрать Del_SubStr и нажать Выполнить. Если в данном коде в строке
If -(InStr(Cells(li, 1), sSubStr) > 0) = lMet Then
вместо = lMet указать <> lMet , то удаляться будут строки, не содержащие указанное для поиска значение. Иногда тоже удобно.
Но. Данный код просматривает строки на предмет частичного совпадения указанного значения. Например, если Вы укажете текст для поиска "отчет", то будут удалены все строки, в которых встречается это слово("квартальный отчет", "отчет за месяц" и т.д.). Это не всегда нужно. Поэтому ниже приведен код, который будет удалять только строки, указанные ячейки которых равны конкретно указанному значению:Здесь так же, как и в случае с предыдущим кодом можно заменить оператор сравнения( Cells(li, lCol) = sSubStr ) с равно на неравенство( Cells(li, lCol) <> sSubStr ) и тогда удаляться будут строки, значения ячеек которых не равно указанному.
УДАЛЕНИЕ СТРОК НА ОСНОВАНИИ СПИСКА ЗНАЧЕНИЙ(МНОЖЕСТВЕННЫЕ КРИТЕРИИ)
Иногда бывают ситуации, когда необходимо удалить строки не по одному значению, а по нескольким. Например, если строка содержит или Итог или Отчет. Ниже приведен код, при помощи которого можно удалить строки, указав в качестве критерия диапазон значений.
Значения, которые необходимо найти и удалить перечисляются на листе с именем "Лист2". Т.е. указав на "Лист2" в столбце А(начиная с первой строки) несколько значений - они все будут удалены. Если лист называется иначе(скажем "Соответствия") в коде необходимо будет "Лист2" заменить на "Соответствия". Удаление строк происходит на активном в момент запуска кода листе. Это значит, что перед запуском кода надо перейти на тот лист, строки в котором необходимо удалить.Sub Del_Array_SubStr() Dim sSubStr As String 'искомое слово или фраза Dim lCol As Long 'номер столбца с просматриваемыми значениями Dim lLastRow As Long, li As Long Dim avArr, lr As Long Dim arr lCol = Val(InputBox("Укажите номер столбца, в котором искать указанное значение", "www.excel-vba.ru", 1)) If lCol = 0 Then Exit Sub Application.ScreenUpdating = 0 lLastRow = ActiveSheet.UsedRange.Row - 1 + ActiveSheet.UsedRange.Rows.Count 'заносим в массив значения листа, в котором необходимо удалить строки arr = Cells(1, lCol).Resize(lLastRow).Value 'Получаем с Лист2 значения, которые надо удалить в активном листе With Sheets("Лист2") 'Имя листа с диапазоном значений на удаление avArr = .Range(.Cells(1, 1), .Cells(.Rows.Count, 1).End(xlUp)) End With 'удаляем Dim rr As Range For lr = 1 To UBound(avArr, 1) sSubStr = avArr(lr, 1) For li = 1 To lLastRow 'цикл с первой строки до конца If CStr(arr(li, 1)) = sSubStr Then If rr Is Nothing Then Set rr = Cells(li, 1) Else Set rr = Union(rr, Cells(li, 1)) End If End If DoEvents Next li DoEvents Next lr If Not rr Is Nothing Then rr.EntireRow.Delete Application.ScreenUpdating = 1 End Sub
Чтобы код выше удалял строки не по точному совпадению слов, а по частичному(например, в ячейке записано "Привет, как дела?", а в списке есть слово "привет" - надо удалить, т.к. есть слово "привет"), то надо строку:
If CStr(arr(li, 1)) = sSubStr Then
заменить на такую:
If InStr(1, arr(li, 1), sSubStr, 1) > 0 Then
УДАЛЕНИЕ ИЗ ЛИСТА СТРОК, КОТОРЫХ НЕТ В СПИСКЕ ЗНАЧЕНИЙ(МНОЖЕСТВЕННЫЕ КРИТЕРИИ)
Т.к. в последнее время стало поступать все больше и больше вопросов как не удалять значения по списку, а наоборот - оставить в таблице только те значения, которые перечислены в списке - решил дополнить статью и таким кодом.
Значения, которые необходимо оставить перечисляются на листе с именем "Лист2". Т.е. указав на "Лист2" в столбце А(начиная с первой строки) несколько значений - после работы кода на листе будут оставлены только те строки, в которых присутствует хоть одно из перечисленных в списке значений. Если лист называется иначе(скажем "Соответствия") в коде необходимо будет "Лист2" заменить на "Соответствия". Удаление строк происходит на активном в момент запуска кода листе. Это значит, что перед запуском кода надо перейти на тот лист, строки в котором необходимо удалить.
В отличие от приведенных выше кодов, данный код ориентирован на то, что значения в списке указаны не полностью. Т.е. если необходимо оставить только те ячейки, в которых встречается слово "активы", то в списке надо указать только это слово. В этом случае если в ячейке будет записана фраза "Нематериальные активы" или "Активы сторонние" - эти ячейки не будут удалены, т.к. в них встречается слово "активы". Регистр букв при этом неважен.'процедура оставляет в листе только те значения, которые перечислены в списке Sub LeaveOnlyFoundInArray() Dim sSubStr As String 'искомое слово или фраза Dim lCol As Long 'номер столбца с просматриваемыми значениями Dim lLastRow As Long, li As Long Dim avArr, lr As Long Dim arr Dim IsFind As Boolean lCol = Val(InputBox("Укажите номер столбца, в котором искать указанное значение", "www.excel-vba.ru", 1)) If lCol = 0 Then Exit Sub Application.ScreenUpdating = 0 lLastRow = ActiveSheet.UsedRange.Row - 1 + ActiveSheet.UsedRange.Rows.Count 'заносим в массив значения листа, в котором необходимо удалить строки arr = Cells(1, lCol).Resize(lLastRow).Value 'Получаем с Лист2 значения, которые надо удалить в активном листе With Sheets("Лист2") 'Имя листа с диапазоном значений на удаление avArr = .Range(.Cells(1, 1), .Cells(.Rows.Count, 1).End(xlUp)) End With 'удаляем Dim rr As Range For li = 1 To lLastRow 'цикл с первой строки таблицы до конца IsFind = False For lr = 1 To UBound(avArr, 1) 'цикл по списку значений на удаление sSubStr = avArr(lr, 1) If InStr(1, arr(li, 1), sSubStr, 1) > 0 Then IsFind = True End If DoEvents Next lr 'если значение таблицы не найдено в списке - удаляем строку If Not IsFind Then If rr Is Nothing Then Set rr = Cells(li, 1) Else Set rr = Union(rr, Cells(li, 1)) End If End If DoEvents Next li If Not rr Is Nothing Then rr.EntireRow.Delete Application.ScreenUpdating = 1 End Sub
Чтобы код выше сравнивал значения таблицы со значениями списка по точному совпадению слов, а не по частичному, то надо строку:
Пустые строки и столбцы могут быть головной болью в таблицах во многих случаях. Стандартные функции сортировки, фильтрации, подведения итогов, создания сводных таблиц и т.д. воспринимают пустые строки и столбцы как разрыв таблицы, не подхватывая данные, расположенные за ними далее. Если таких разрывов много, то удалять их вручную может оказаться весьма затратно, а удалить сразу всех "оптом", используя фильтрацию не получится, т.к. фильтр тоже будет «спотыкаться» на разрывах.
Давайте рассмотрим несколько способов решения этой задачи.
Способ 1. Поиск пустых ячеек
Это, может, и не самый удобный, но точно самый простой способ вполне достойный упоминания.
Предположим, что мы имеем дело вот с такой таблицей, содержащей внутри множество пустых строк и столбцов (для наглядности выделены цветом):
Допустим, мы уверены, что в первом столбце нашей таблицы (колонка B) всегда обязательно присутствует название какого-либо города. Тогда пустые ячейки в этой колонке будут признаком ненужных пустых строк. Чтобы быстро их все удалить делаем следующее:
- Выделяем диапазон с городами (B2:B26)
- Нажимаем клавишу F5 и затем кнопку Выделить (Go to Special) или выбираем на вкладке Главная - Найти и выделить - Выделить группу ячеек (Home - Find&Select - Go to special) .
- В открывшемся окне выбираем опцию Пустые ячейки (Blanks) и жмём ОК – должны выделиться все пустые ячейки в первом столбце нашей таблицы.
- Теперь выбираем на вкладке Главная команду Удалить - Удалить строки с листа (Delete - Delete rows) или жмём сочетание клавиш Ctrl + минус - и наша задача решена.
Само-собой, от пустых столбцов можно избавиться совершенно аналогично, взяв за основу шапку таблицы.
Способ 2. Поиск незаполненных строк
Как вы, возможно, уже сообразили, предыдущий способ сработает только в том случае, если в наших данных обязательно присутствую полностью заполненные строки и столбцы, за которые можно зацепиться при поиске пустых ячеек. Но что, если такой уверенности нет, и в данных могут содержаться и пустые ячейки в том числе?
Взгляните, например, на следующую таблицу - как раз такой случай:
Здесь подход будет чуть похитрее:
-
Введём в ячейку A2 функцию СЧЁТЗ (COUNTA) , которая вычислит количество заполненных ячеек в строке правее и скопируем эту формулу вниз на всю таблицу:
К сожалению, со столбцами такой трюк уже не проделать – фильтровать по столбцам Excel пока не научился.
Способ 3. Макрос удаления всех пустых строк и столбцов на листе
Для автоматизации подобной задачи можно использовать и простой макрос. Нажмите сочетание клавиш Alt + F11 или выберите на вкладке Разработчик - Visual Basic (Developer - Visual Basic Editor) . Если вкладки Разработчик не видно, то можно включить ее через Файл - Параметры - Настройка ленты (File - Options - Customize Ribbon) .
В открывшемся окне редактора Visual Basic выберите команду меню Insert - Module и в появившийся пустой модуль скопируйте и вставьте следующие строки:
Закройте редактор и вернитесь в Excel.
Теперь нажмите сочетание Alt + F8 или кнопку Макросы на вкладке Разработчик. В открывшемся окне будут перечислены все доступные вам в данный момент для запуска макросы, в том числе только что созданный макрос DeleteEmpty. Выберите его и нажмите кнопку Выполнить (Run) - все пустые строки и столбцы на листе будут мгновенно удалены.
Способ 4. Запрос Power Query
Ещё один способ решить нашу задачу и весьма частый сценарий - это удаление пустых строк и столбцов в Power Query.
Сначала давайте загрузим нашу таблицу в редактор запросов Power Query. Можно конвертировать её в динамическую "умную" сочетанием клавиш Ctrl+T или же просто выделить наш диапазон данных и дать ему имя (например Данные) в строке формул, преобразовав в именованный:
Теперь используем команду Данные - Получить данные - Из таблицы/диапазона (Data - Get Data - From table/range) и грузим всё в Power Query:
Дальше всё просто:
- Удаляем пустые строки командой Главная - Сократить строки - Удалить строки - Удалить пустые строки (Home - Remove Rows - Remove empty rows).
- Щёлкаем правой кнопкой мыши по заголовку первого столбца Город и выбираем в контекстном меню команду Отменить свёртывание других столбцов (Unpivot Other Columns). Наша таблица будет, как это технически правильно называется, нормализована - преобразована в три столбца: город, месяц и значение с пересечения города и месяца из исходной таблицы. Особенность этой операции в Power Query в том, что она пропускает в исходных данных пустые ячейки, что нам и требуется:
Добрый день всем.
Помогите реализовать задумку (сам смог лишь к этому прийти - не без помощи интеренета)Имеется таблица (в некоторых столбцах имеются формулы) 5 строк в данной таблице никогда не удаляются
Задача:
в ячейке Е1 значение (условие) которое говорит о количестве строк в данной таблице (оно не будет ниже 5 - никогда)
Задача дополнить нужное количество строк чтоб реализовать условиеЗаранее спасибо огромное всем кто откликнется
Добрый день всем.
Помогите реализовать задумку (сам смог лишь к этому прийти - не без помощи интеренета)Имеется таблица (в некоторых столбцах имеются формулы) 5 строк в данной таблице никогда не удаляются
Задача:
в ячейке Е1 значение (условие) которое говорит о количестве строк в данной таблице (оно не будет ниже 5 - никогда)
Задача дополнить нужное количество строк чтоб реализовать условиеЗаранее спасибо огромное всем кто откликнется anisimovaleksandr32
Имеется таблица (в некоторых столбцах имеются формулы) 5 строк в данной таблице никогда не удаляются
Задача:
в ячейке Е1 значение (условие) которое говорит о количестве строк в данной таблице (оно не будет ниже 5 - никогда)
Задача дополнить нужное количество строк чтоб реализовать условиеЗаранее спасибо огромное всем кто откликнется Автор - anisimovaleksandr32
Дата добавления - 06.04.2022 в 16:01Положите файл xlsx (без макросов). У меня политика безопасности запрещает скачивать файлы с макросами
Положите файл xlsx (без макросов). У меня политика безопасности запрещает скачивать файлы с макросами _Boroda_
Sub Макрос1()
Dim tb As Object
n_ = Cells(1, 5).Value
If n_ Set tb = ActiveSheet.ListObjects("Таблица1")
nr_ = tb.ListRows.Count
ndob_ = n_ - nr_
If ndob_ < 1 Then
MsgBox "В таблице уже есть " & n_ & " строк"
Exit Sub
End If
Application.ScreenUpdating = 0
Application.Calculation = 3
tb.ShowTotals = True
Cells(Range(tb).Row + nr_, 1).Resize(ndob_).EntireRow.Insert
tb.ShowTotals = False
Application.Calculation = 1
Application.ScreenUpdating = 1
End SubSub Макрос1()
Dim tb As Object
n_ = Cells(1, 5).Value
If n_ Set tb = ActiveSheet.ListObjects("Таблица1")
nr_ = tb.ListRows.Count
ndob_ = n_ - nr_
If ndob_ < 1 Then
MsgBox "В таблице уже есть " & n_ & " строк"
Exit Sub
End If
Application.ScreenUpdating = 0
Application.Calculation = 3
tb.ShowTotals = True
Cells(Range(tb).Row + nr_, 1).Resize(ndob_).EntireRow.Insert
tb.ShowTotals = False
Application.Calculation = 1
Application.ScreenUpdating = 1
End SubSub Макрос1()
Dim tb As Object
n_ = Cells(1, 5).Value
If n_ Set tb = ActiveSheet.ListObjects("Таблица1")
nr_ = tb.ListRows.Count
ndob_ = n_ - nr_
If ndob_ < 1 Then
MsgBox "В таблице уже есть " & n_ & " строк"
Exit Sub
End If
Application.ScreenUpdating = 0
Application.Calculation = 3
tb.ShowTotals = True
Cells(Range(tb).Row + nr_, 1).Resize(ndob_).EntireRow.Insert
tb.ShowTotals = False
Application.Calculation = 1
Application.ScreenUpdating = 1
End Sub_Boroda_, спасибо огромное.
Я дико извеняюсь.
Не могли бы помочь разобраться (просто расписал комментариями):Sub Макрос1()
Dim tb As Object
n_ = Cells(1, 5).Value 'значение в ячеке для условия (в дальнейшем используется как n_)
If n_ Set tb = ActiveSheet.ListObjects("Таблица1") 'Присваивается переменный диапазон ячеек с помощью оператора Set
nr_ = tb.ListRows.Count
ndob_ = n_ - nr_ 'вычисления амортизации (вроде как!?)параметра n_
If ndob_ < 1 Then 'и если n_ просчитает амартизацию и оно будет (чет запутался)
MsgBox "В таблице уже есть " & n_ & " строк"
Exit Sub
End If
Application.ScreenUpdating = 0
Application.Calculation = 3
tb.ShowTotals = True 'Получает или задает логическое значение, указывающее, видна ли общая строка
Cells(Range(tb).Row + nr_, 1).Resize(ndob_).EntireRow.Insert
tb.ShowTotals = False 'Получает или задает логическое значение, указывающее, видна ли общая строка
Application.Calculation = 1
Application.ScreenUpdating = 1
End Subа удалением строк
Данная таблица ни когда не будет меньше 5 основных строк
- она может дополнятся
- она может уменьшаться /удаляться
до нужных количеств строк в зависимости от ячейки Е1(условие)А так прям на УРА СПАСИБО ОГРОМНЕЙШЕЕ
_Boroda_, спасибо огромное.
Я дико извеняюсь.
Не могли бы помочь разобраться (просто расписал комментариями):Sub Макрос1()
Dim tb As Object
n_ = Cells(1, 5).Value 'значение в ячеке для условия (в дальнейшем используется как n_)
If n_ Set tb = ActiveSheet.ListObjects("Таблица1") 'Присваивается переменный диапазон ячеек с помощью оператора Set
nr_ = tb.ListRows.Count
ndob_ = n_ - nr_ 'вычисления амортизации (вроде как!?)параметра n_
If ndob_ < 1 Then 'и если n_ просчитает амартизацию и оно будет (чет запутался)
MsgBox "В таблице уже есть " & n_ & " строк"
Exit Sub
End If
Application.ScreenUpdating = 0
Application.Calculation = 3
tb.ShowTotals = True 'Получает или задает логическое значение, указывающее, видна ли общая строка
Cells(Range(tb).Row + nr_, 1).Resize(ndob_).EntireRow.Insert
tb.ShowTotals = False 'Получает или задает логическое значение, указывающее, видна ли общая строка
Application.Calculation = 1
Application.ScreenUpdating = 1
End Subа удалением строк
Данная таблица ни когда не будет меньше 5 основных строк
- она может дополнятся
- она может уменьшаться /удаляться
до нужных количеств строк в зависимости от ячейки Е1(условие)А так прям на УРА СПАСИБО ОГРОМНЕЙШЕЕ anisimovaleksandr32
Sub Макрос1()
Dim tb As Object
n_ = Cells(1, 5).Value 'значение в ячеке для условия (в дальнейшем используется как n_)
If n_ Set tb = ActiveSheet.ListObjects("Таблица1") 'Присваивается переменный диапазон ячеек с помощью оператора Set
nr_ = tb.ListRows.Count
ndob_ = n_ - nr_ 'вычисления амортизации (вроде как!?)параметра n_
If ndob_ < 1 Then 'и если n_ просчитает амартизацию и оно будет (чет запутался)
MsgBox "В таблице уже есть " & n_ & " строк"
Exit Sub
End If
Application.ScreenUpdating = 0
Application.Calculation = 3
tb.ShowTotals = True 'Получает или задает логическое значение, указывающее, видна ли общая строка
Cells(Range(tb).Row + nr_, 1).Resize(ndob_).EntireRow.Insert
tb.ShowTotals = False 'Получает или задает логическое значение, указывающее, видна ли общая строка
Application.Calculation = 1
Application.ScreenUpdating = 1
End Subа удалением строк
Данная таблица ни когда не будет меньше 5 основных строк
- она может дополнятся
- она может уменьшаться /удаляться
до нужных количеств строк в зависимости от ячейки Е1(условие)А так прям на УРА СПАСИБО ОГРОМНЕЙШЕЕ Автор - anisimovaleksandr32
Дата добавления - 06.04.2022 в 18:54пытаюсь убрать MsgBox
И врезаться так вот
как топором работаю (((( прекрасно осознаюпытаюсь убрать MsgBox
И врезаться так вот
как топором работаю (((( прекрасно осознаю anisimovaleksandr32Sub Макрос1()
Dim tb As Object
n_ = Cells(1, 5).Value 'значение в ячеке для условия (в дальнейшем используется как n_)
If n_ Set tb = ActiveSheet.ListObjects("Таблица1") 'Присваивается переменный диапазон ячеек с помощью оператора Set
nr_ = tb.ListRows.Count
ndob_ = n_ - nr_ 'вычисления амортизации (вроде как!?)параметра n_
If ndob_Rows("13:" & nr_ - 1).Delete xlShiftUp 'и если n_ просчитает амартизацию и оно будет (чет запутался)
MsgBox "В таблице уже есть " & n_ & " строк"
Exit Sub
End IfApplication.ScreenUpdating = 0
Application.Calculation = 3
tb.ShowTotals = True 'Получает или задает логическое значение, указывающее, видна ли общая строка
Cells(Range(tb).Row + nr_, 1).Resize(ndob_).EntireRow.Insert
tb.ShowTotals = False 'Получает или задает логическое значение, указывающее, видна ли общая строка
Application.Calculation = 1
Application.ScreenUpdating = 1
End SubПо сути срабатывает но не корретно
Sub Макрос1()
Dim tb As Object
n_ = Cells(1, 5).Value 'значение в ячеке для условия (в дальнейшем используется как n_)
If n_ Set tb = ActiveSheet.ListObjects("Таблица1") 'Присваивается переменный диапазон ячеек с помощью оператора Set
nr_ = tb.ListRows.Count
ndob_ = n_ - nr_ 'вычисления амортизации (вроде как!?)параметра n_
If ndob_Rows("13:" & nr_ - 1).Delete xlShiftUp 'и если n_ просчитает амартизацию и оно будет (чет запутался)
MsgBox "В таблице уже есть " & n_ & " строк"
Exit Sub
End IfApplication.ScreenUpdating = 0
Application.Calculation = 3
tb.ShowTotals = True 'Получает или задает логическое значение, указывающее, видна ли общая строка
Cells(Range(tb).Row + nr_, 1).Resize(ndob_).EntireRow.Insert
tb.ShowTotals = False 'Получает или задает логическое значение, указывающее, видна ли общая строка
Application.Calculation = 1
Application.ScreenUpdating = 1
End SubПо сути срабатывает но не корретно anisimovaleksandr32
Sub Макрос1()
Dim tb As Object
n_ = Cells(1, 5).Value 'значение в ячеке для условия (в дальнейшем используется как n_)
If n_ Set tb = ActiveSheet.ListObjects("Таблица1") 'Присваивается переменный диапазон ячеек с помощью оператора Set
nr_ = tb.ListRows.Count
ndob_ = n_ - nr_ 'вычисления амортизации (вроде как!?)параметра n_
If ndob_Rows("13:" & nr_ - 1).Delete xlShiftUp 'и если n_ просчитает амартизацию и оно будет (чет запутался)
MsgBox "В таблице уже есть " & n_ & " строк"
Exit Sub
End IfApplication.ScreenUpdating = 0
Application.Calculation = 3
tb.ShowTotals = True 'Получает или задает логическое значение, указывающее, видна ли общая строка
Cells(Range(tb).Row + nr_, 1).Resize(ndob_).EntireRow.Insert
tb.ShowTotals = False 'Получает или задает логическое значение, указывающее, видна ли общая строка
Application.Calculation = 1
Application.ScreenUpdating = 1
End SubПо сути срабатывает но не корретно Автор - anisimovaleksandr32
Дата добавления - 06.04.2022 в 19:58Sub Макрос1()
Dim tb As Object
n_ = Cells(1, 5).Value
If n_ < 5 Then Exit Sub
Set tb = ActiveSheet.ListObjects("Таблица1")
nr_ = tb.ListRows.Count
ndob_ = n_ - nr_
If ndob_ Then
Application.ScreenUpdating = 0
Application.Calculation = 3
If ndob_ > 0 Then
For i = 1 To Abs(ndob_)
tb.ListRows.Add
Next i
Else
For i = 1 To Abs(ndob_)
tb.ListRows(6).Delete
Next i
End If
Application.Calculation = 1
Application.ScreenUpdating = 1
End If
End SubSub Макрос1()
Dim tb As Object
n_ = Cells(1, 5).Value
If n_ < 5 Then Exit Sub
Set tb = ActiveSheet.ListObjects("Таблица1")
nr_ = tb.ListRows.Count
ndob_ = n_ - nr_
If ndob_ Then
Application.ScreenUpdating = 0
Application.Calculation = 3
If ndob_ > 0 Then
For i = 1 To Abs(ndob_)
tb.ListRows.Add
Next i
Else
For i = 1 To Abs(ndob_)
tb.ListRows(6).Delete
Next i
End If
Application.Calculation = 1
Application.ScreenUpdating = 1
End If
End SubSub Макрос1()
Dim tb As Object
n_ = Cells(1, 5).Value
If n_ < 5 Then Exit Sub
Set tb = ActiveSheet.ListObjects("Таблица1")
nr_ = tb.ListRows.Count
ndob_ = n_ - nr_
If ndob_ Then
Application.ScreenUpdating = 0
Application.Calculation = 3
If ndob_ > 0 Then
For i = 1 To Abs(ndob_)
tb.ListRows.Add
Next i
Else
For i = 1 To Abs(ndob_)
tb.ListRows(6).Delete
Next i
End If
Application.Calculation = 1
Application.ScreenUpdating = 1
End If
End SubЕсть файл, где на листе Аномалии есть умная таблица. На другом листе кнопка.
Есть файл, где на листе Аномалии есть умная таблица. На другом листе кнопка.
Есть файл, где на листе Аномалии есть умная таблица. На другом листе кнопка.
Sub qq()
Dim i&
With Worksheets("$Аномалии").ListObjects(1).ListColumns("Тип аномалии")
For i = .Range.Row + .ListRows.Count To .Range.Row Step -1
If Worksheets("$Аномалии").Cells(i, .Column) = "Недостача" Then Worksheets("$Аномалии").Cells(i, .Column).Delete
Next
End With
End SubSub qq()
Dim i&
With Worksheets("$Аномалии").ListObjects(1).ListColumns("Тип аномалии")
For i = .Range.Row + .ListRows.Count To .Range.Row Step -1
If Worksheets("$Аномалии").Cells(i, .Column) = "Недостача" Then Worksheets("$Аномалии").Cells(i, .Column).Delete
Next
End With
End SubБыть или не быть, вот в чем загвоздка!
Sub qq()
Dim i&
With Worksheets("$Аномалии").ListObjects(1).ListColumns("Тип аномалии")
For i = .Range.Row + .ListRows.Count To .Range.Row Step -1
If Worksheets("$Аномалии").Cells(i, .Column) = "Недостача" Then Worksheets("$Аномалии").Cells(i, .Column).Delete
Next
End With
End SubКстати выдает ошибку на вашем коде в строке, где For. Объект не поддерживает метод или что-то вроде этого.
Кстати выдает ошибку на вашем коде в строке, где For. Объект не поддерживает метод или что-то вроде этого.
Кстати выдает ошибку на вашем коде в строке, где For. Объект не поддерживает метод или что-то вроде этого.
Sub qq()
Dim i&
With Worksheets("$Аномалии").ListObjects(1)
For i = .Range.Row + .ListRows.Count To .Range.Row Step -1
If Worksheets("$Аномалии").Cells(i, .ListColumns("Тип аномалии").Range.Column) = "Недостача" Then Worksheets("$Аномалии").Cells(i, .ListColumns("Тип аномалии").Range.Column).Delete
Next
End With
End Sub
Sub ww()
Dim i&
With Worksheets("$Аномалии").ListObjects(1)
i = .Range.Row + .ListRows.Count
Do While i > .Range.Row
If Worksheets("$Аномалии").Cells(i, .ListColumns("Тип аномалии").Range.Column) = "Недостача" Then Worksheets("$Аномалии").Cells(i, .ListColumns("Тип аномалии").Range.Column).Delete
i = i - 1
DoEvents ' для возможности прерывания кода в случае ошибки
Loop
End With
End SubЦикл на удаление строк всегда идет снизу вверх, иначе неизбежны (или преодолимы весьма сложными плясками с бубном) ошибки.
.ListColumns("Тип аномалии").Range.Column можно заменить на 6
Sub qq()
Dim i&
With Worksheets("$Аномалии").ListObjects(1)
For i = .Range.Row + .ListRows.Count To .Range.Row Step -1
If Worksheets("$Аномалии").Cells(i, .ListColumns("Тип аномалии").Range.Column) = "Недостача" Then Worksheets("$Аномалии").Cells(i, .ListColumns("Тип аномалии").Range.Column).Delete
Next
End With
End Sub
Sub ww()
Dim i&
With Worksheets("$Аномалии").ListObjects(1)
i = .Range.Row + .ListRows.Count
Do While i > .Range.Row
If Worksheets("$Аномалии").Cells(i, .ListColumns("Тип аномалии").Range.Column) = "Недостача" Then Worksheets("$Аномалии").Cells(i, .ListColumns("Тип аномалии").Range.Column).Delete
i = i - 1
DoEvents ' для возможности прерывания кода в случае ошибки
Loop
End With
End SubЦикл на удаление строк всегда идет снизу вверх, иначе неизбежны (или преодолимы весьма сложными плясками с бубном) ошибки.
.ListColumns("Тип аномалии").Range.Column можно заменить на 6 RAN
Sub qq()
Dim i&
With Worksheets("$Аномалии").ListObjects(1)
For i = .Range.Row + .ListRows.Count To .Range.Row Step -1
If Worksheets("$Аномалии").Cells(i, .ListColumns("Тип аномалии").Range.Column) = "Недостача" Then Worksheets("$Аномалии").Cells(i, .ListColumns("Тип аномалии").Range.Column).Delete
Next
End With
End Sub
Sub ww()
Dim i&
With Worksheets("$Аномалии").ListObjects(1)
i = .Range.Row + .ListRows.Count
Do While i > .Range.Row
If Worksheets("$Аномалии").Cells(i, .ListColumns("Тип аномалии").Range.Column) = "Недостача" Then Worksheets("$Аномалии").Cells(i, .ListColumns("Тип аномалии").Range.Column).Delete
i = i - 1
DoEvents ' для возможности прерывания кода в случае ошибки
Loop
End With
End SubЦикл на удаление строк всегда идет снизу вверх, иначе неизбежны (или преодолимы весьма сложными плясками с бубном) ошибки.
.ListColumns("Тип аномалии").Range.Column можно заменить на 6 Автор - RAN
Дата добавления - 15.12.2019 в 20:08Предположу, что почти каждый сталкивался с ситуацией, когда необходимо удалить только определенные строки: имеется большая таблица и необходимо удалить из неё только те строки, которые содержат какое-то слово (цифру, фразу). Для выполнения подобной задачи можно воспользоваться несколькими способами.
Способ первый:
Использовать встроенное средство Excel - фильтр. Сначала его необходимо "установить" на листе:- Выделяем таблицу с данными, включая заголовки. Если их нет - то выделяем с самой первой строки таблицы, в которой необходимо удалить данные
- устанавливаем фильтр:
- для Excel 2003 : Данные-Фильтр-Автофильтр
- для Excel 2007-2010 : вкладка Данные (Data) -Фильтр (Filter)(или вкладка Главная (Home) -Сортировка и фильтр (Sort&Filter) -Фильтр (Filter) )
Теперь выбираем условие для фильтра:
- в Excel 2003 надо выбрать Условие и в появившейся форме выбрать непосредственно условие("равно", "содержит", "начинается с" и т.д.), а напротив значение в соответствии с условием.
- Для 2007-2010 Excel нужно выбрать Текстовые фильтры (Text Filters) и либо сразу выбрать одно из предлагаемых условий, либо нажать Настраиваемый фильтр (Custom Filter) и ввести значения для отбора в форме
После этого удалить отфильтрованные строки. В 2007 Excel могут возникнуть проблемы с удалением отфильтрованных строк, поэтому рекомендую сначала так же прочитать статью: Excel удаляет вместо отфильтрованных строк - все?! Как избежать.
Способ второй:
применить код VBA, который потребует только указания значения, которое необходимо найти в строке и номер столбца, в котором искать значение.Если значение sSubStr не будет указано, то будут удалены строки, ячейки указанного столбца которых, пустые.
Данный код необходимо поместить в стандартный модуль. Вызвать с листа его можно нажатием клавиш Alt + F8 , после чего выбрать Del_SubStr и нажать Выполнить. Если в данном коде в строке
If -(InStr(Cells(li, 1), sSubStr) > 0) = lMet Then
вместо = lMet указать <> lMet , то удаляться будут строки, не содержащие указанное для поиска значение. Иногда тоже удобно.
Но. Данный код просматривает строки на предмет частичного совпадения указанного значения. Например, если Вы укажете текст для поиска "отчет", то будут удалены все строки, в которых встречается это слово("квартальный отчет", "отчет за месяц" и т.д.). Это не всегда нужно. Поэтому ниже приведен код, который будет удалять только строки, указанные ячейки которых равны конкретно указанному значению:Здесь так же, как и в случае с предыдущим кодом можно заменить оператор сравнения( Cells(li, lCol) = sSubStr ) с равно на неравенство( Cells(li, lCol) <> sSubStr ) и тогда удаляться будут строки, значения ячеек которых не равно указанному.
УДАЛЕНИЕ СТРОК НА ОСНОВАНИИ СПИСКА ЗНАЧЕНИЙ(МНОЖЕСТВЕННЫЕ КРИТЕРИИ)
Иногда бывают ситуации, когда необходимо удалить строки не по одному значению, а по нескольким. Например, если строка содержит или Итог или Отчет. Ниже приведен код, при помощи которого можно удалить строки, указав в качестве критерия диапазон значений.
Значения, которые необходимо найти и удалить перечисляются на листе с именем "Лист2". Т.е. указав на "Лист2" в столбце А(начиная с первой строки) несколько значений - они все будут удалены. Если лист называется иначе(скажем "Соответствия") в коде необходимо будет "Лист2" заменить на "Соответствия". Удаление строк происходит на активном в момент запуска кода листе. Это значит, что перед запуском кода надо перейти на тот лист, строки в котором необходимо удалить.Sub Del_Array_SubStr() Dim sSubStr As String 'искомое слово или фраза Dim lCol As Long 'номер столбца с просматриваемыми значениями Dim lLastRow As Long, li As Long Dim avArr, lr As Long Dim arr lCol = Val(InputBox("Укажите номер столбца, в котором искать указанное значение", "www.excel-vba.ru", 1)) If lCol = 0 Then Exit Sub Application.ScreenUpdating = 0 lLastRow = ActiveSheet.UsedRange.Row - 1 + ActiveSheet.UsedRange.Rows.Count 'заносим в массив значения листа, в котором необходимо удалить строки arr = Cells(1, lCol).Resize(lLastRow).Value 'Получаем с Лист2 значения, которые надо удалить в активном листе With Sheets("Лист2") 'Имя листа с диапазоном значений на удаление avArr = .Range(.Cells(1, 1), .Cells(.Rows.Count, 1).End(xlUp)) End With 'удаляем Dim rr As Range For lr = 1 To UBound(avArr, 1) sSubStr = avArr(lr, 1) For li = 1 To lLastRow 'цикл с первой строки до конца If CStr(arr(li, 1)) = sSubStr Then If rr Is Nothing Then Set rr = Cells(li, 1) Else Set rr = Union(rr, Cells(li, 1)) End If End If DoEvents Next li DoEvents Next lr If Not rr Is Nothing Then rr.EntireRow.Delete Application.ScreenUpdating = 1 End Sub
Чтобы код выше удалял строки не по точному совпадению слов, а по частичному(например, в ячейке записано "Привет, как дела?", а в списке есть слово "привет" - надо удалить, т.к. есть слово "привет"), то надо строку:
If CStr(arr(li, 1)) = sSubStr Then
заменить на такую:
If InStr(1, arr(li, 1), sSubStr, 1) > 0 Then
УДАЛЕНИЕ ИЗ ЛИСТА СТРОК, КОТОРЫХ НЕТ В СПИСКЕ ЗНАЧЕНИЙ(МНОЖЕСТВЕННЫЕ КРИТЕРИИ)
Т.к. в последнее время стало поступать все больше и больше вопросов как не удалять значения по списку, а наоборот - оставить в таблице только те значения, которые перечислены в списке - решил дополнить статью и таким кодом.
Значения, которые необходимо оставить перечисляются на листе с именем "Лист2". Т.е. указав на "Лист2" в столбце А(начиная с первой строки) несколько значений - после работы кода на листе будут оставлены только те строки, в которых присутствует хоть одно из перечисленных в списке значений. Если лист называется иначе(скажем "Соответствия") в коде необходимо будет "Лист2" заменить на "Соответствия". Удаление строк происходит на активном в момент запуска кода листе. Это значит, что перед запуском кода надо перейти на тот лист, строки в котором необходимо удалить.
В отличие от приведенных выше кодов, данный код ориентирован на то, что значения в списке указаны не полностью. Т.е. если необходимо оставить только те ячейки, в которых встречается слово "активы", то в списке надо указать только это слово. В этом случае если в ячейке будет записана фраза "Нематериальные активы" или "Активы сторонние" - эти ячейки не будут удалены, т.к. в них встречается слово "активы". Регистр букв при этом неважен.'процедура оставляет в листе только те значения, которые перечислены в списке Sub LeaveOnlyFoundInArray() Dim sSubStr As String 'искомое слово или фраза Dim lCol As Long 'номер столбца с просматриваемыми значениями Dim lLastRow As Long, li As Long Dim avArr, lr As Long Dim arr Dim IsFind As Boolean lCol = Val(InputBox("Укажите номер столбца, в котором искать указанное значение", "www.excel-vba.ru", 1)) If lCol = 0 Then Exit Sub Application.ScreenUpdating = 0 lLastRow = ActiveSheet.UsedRange.Row - 1 + ActiveSheet.UsedRange.Rows.Count 'заносим в массив значения листа, в котором необходимо удалить строки arr = Cells(1, lCol).Resize(lLastRow).Value 'Получаем с Лист2 значения, которые надо удалить в активном листе With Sheets("Лист2") 'Имя листа с диапазоном значений на удаление avArr = .Range(.Cells(1, 1), .Cells(.Rows.Count, 1).End(xlUp)) End With 'удаляем Dim rr As Range For li = 1 To lLastRow 'цикл с первой строки таблицы до конца IsFind = False For lr = 1 To UBound(avArr, 1) 'цикл по списку значений на удаление sSubStr = avArr(lr, 1) If InStr(1, arr(li, 1), sSubStr, 1) > 0 Then IsFind = True End If DoEvents Next lr 'если значение таблицы не найдено в списке - удаляем строку If Not IsFind Then If rr Is Nothing Then Set rr = Cells(li, 1) Else Set rr = Union(rr, Cells(li, 1)) End If End If DoEvents Next li If Not rr Is Nothing Then rr.EntireRow.Delete Application.ScreenUpdating = 1 End Sub
Чтобы код выше сравнивал значения таблицы со значениями списка по точному совпадению слов, а не по частичному, то надо строку:
Читайте также: