Excel: как удалить строки с определенным текстом
В следующем пошаговом примере показано, как удалить в Excel все строки, содержащие определенный текст.
Шаг 1: Создайте данные
Во-первых, давайте создадим набор данных, который показывает рейтинги трех игроков в разных баскетбольных командах:
Шаг 2. Найдите значения с определенным текстом
Предположим, мы хотим удалить каждую строку, содержащую « Плохо » в качестве одной из оценок.
На вкладке « Главная » нажмите значок « Найти и выбрать », а затем нажмите « Найти » в раскрывающемся меню:
В появившемся новом окне введите Bad в поле поиска и нажмите « Найти все ».
Затем нажмите Ctrl+A , чтобы выделить все ячейки, содержащие текст Bad.Затем нажмите Закрыть .
Все ячейки, содержащие Bad , будут выделены.
Шаг 3: удалите строки с определенным текстом
Затем щелкните значок « Удалить » на вкладке « Главная », а затем выберите « Удалить строки листа » в раскрывающемся меню:
Все строки, содержащие Bad в одной из ячеек, будут автоматически удалены:
Обратите внимание, что ни в одной из оставшихся строк рейтинг игрока не указан как плохой ни в одном из столбцов.
Дополнительные ресурсы
В следующих руководствах объясняется, как выполнять другие распространенные задачи в Excel:
Как удалить в excel строки с определенным текстом
Добрый день!
Прошу помочь дописать макрос по удалению не нужных строк
Требуется удалить строки, которые не содержат определенный текст, т.е. в столбце 9 нужно проверить, содержит ли ячейка одно из значений текста (ду, му00, абк, атс, гств, удтс, тдчс, пмп), и если нет, то ее удалить.
Моих знаний хватило, чтобы написать простой код:
Dim Пример As Worksheet Set Пример = Worksheets("Пример") Row = Пример.Cells(Rows.Count, 1).End(xlUp).Row For i = 2 To Row If InStr(1, Пример.Cells(i, 9), "ду") Or InStr(1, Пример.Cells(i, 9), "му00") Or InStr(1, Пример.Cells(i, 9), "абк") _ Or InStr(1, Пример.Cells(i, 9), "гств") Or InStr(1, Пример.Cells(i, 9), "удтс") Or InStr(1, Пример.Cells(i, 9), "тдчс") _ Or InStr(1, Пример.Cells(i, 9), "атс") Then Else Rows(i).Delete End If Next i
Но строк, для проверки, очень много (около 100 тыс.), поэтому макрос отрабатывает очень долго У меня есть код, который ускоряет процесс
Dim arrKey(), arr(), arrS() Dim lRow&, i&, iKey, iTemp Dim myRng As Range, delRows As Range Dim Пример As Worksheet Set Пример = Worksheets("Пример") arrKey = Array("ду", "му00", "абк", "атс", "гств", "удтс", "тдчс", "пмп") With Worksheets("Пример") Set myRng = .Range(.Cells(2, 1), Cells(.Cells(Rows.Count, 1).End(xlUp).Row, .Cells(2, .Columns.Count).End(xlToLeft).Column)) arr = myRng.Value End With ReDim arrNew(1 To UBound(arr, 1), 1 To UBound(arr, 2)) With CreateObject("Scripting.Dictionary") For Each iKey In arrKey iTemp = .Item(iKey) Next For i = 1 To UBound(arr, 1) If Not .Exists(arr(i, 9)) Then If delRows Is Nothing Then Set delRows = myRng.Rows(i) Else Set delRows = Union(delRows, myRng.Rows(i)) End If End If Next End With If Not delRows Is Nothing Then delRows.Delete
Но удаляются все строки, и как я понимаю, проблема в строке
arrKey = Array("ду", "му00", "абк", "атс", "гств", "удтс", "тдчс", "пмп")
По ней ищется конкретное значение в ячейке, и макрос его не находит, поэтому удаляет все строки, а мне нужно, чтобы он искал содержится ли в ячейке данная часть текста и если нет, то удалить Подскажите пожалуйста, как правильно записать данную строку (или заменить ее)? Возможно нужно какой-то символ поставить, но к сожалению я не нашел ответа в интернете(
Прикрепленные файлы
- Пример.xlsm (25.56 КБ)
покупка
Как в Excel удалить строки, не содержащие определенного текста?
Возможно, некоторые из вас знают, как удалить целые строки, когда они содержат определенные тексты в Excel, но если вы хотите полностью удалить строку, когда они не содержат определенных текстов, как вы могли бы это сделать? Теперь, следуя этому руководству, вы можете найти способ решить эту проблему в Excel.
Удалить строки, не содержащие определенного текста, с помощью фильтра
В Excel функция «Фильтр» может быстро помочь вам отфильтровать строки, не содержащие определенного текста, а затем вы сможете выбрать их для удаления.
1. Выберите столбец, содержащий текст, на основе которого вы будете удалять строки, и нажмите Данные > Фильтр. Смотрите скриншот:
 |
 |
2. В заголовке столбца есть кнопка фильтра, нажмите ее, чтобы открыть раскрывающийся список, отметьте все, кроме определенного текста, на котором вы хотите основываться. Смотрите скриншот:
3. После этого вы увидите только строку заголовка, а строки, не содержащие определенного текста, будут отфильтрованы. Смотрите скриншот ：
4. Выберите все из них, кроме строки заголовка, и щелкните правой кнопкой мыши, чтобы выбрать Удалить строку из контекстного меню. Смотрите скриншот:
5. Затем нажмите Данные > Фильтр снова, а затем удаляются все строки, не содержащие определенного текста. Смотрите скриншот:
 |
 |
Удалить строки, не содержащие определенного текста, с помощью VBA
VBA очень полезен для довольно сложных операций в Excel. Чтобы удалить строки, не содержащие определенного текста, выполните следующие шаги.
1. Нажмите Alt + F11 для отображения Microsoft Visual Basic для приложений окно.
2. В окне нажмите Вставить > Модули чтобы отобразить новое окно модуля, затем скопируйте следующий код VBA в окно модуля.
VBA: удалить всю строку, если ячейка содержит определенный текст.
Sub DeleteRowNoInclude() 'Update20140618 Dim xRow As Range Dim rng As Range Dim WorkRng As Range Dim xStr As String On Error Resume Next xTitleId = "KutoolsforExcel" Set WorkRng = Application.Selection Set WorkRng = Application.InputBox("Range", xTitleId, WorkRng.Address, Type:=8) xStr = Application.InputBox("Text", xTitleId, "", Type:=2) Application.ScreenUpdating = False For i = WorkRng.Rows.Count To 1 Step -1 Set xRow = WorkRng.Rows(i) Set rng = xRow.Find(xStr, LookIn:=xlValues) If rng Is Nothing Then xRow.Delete End If Next Application.ScreenUpdating = True End Sub 3. Нажмите Run , и появится диалоговое окно, в котором вы сможете выбрать рабочий диапазон. Смотрите скриншот:
4. Затем нажмите OKи введите текст, на котором нужно удалить основу строк, в другом всплывающем диалоговом окне. Смотрите скриншот:
5. Нажмите OK, и строки, не содержащие Apple, будут удалены.
Удалить строки, не содержащие определенный текст, с помощью Kutools for Excel
Если вы думаете, что описанные выше методы не являются легкими для вас, вы можете использовать Kutools for Excel‘s Выбрать определенные ячейки функцию.
Kutools for Excel включает более 300 удобных инструментов Excel. Бесплатная пробная версия без ограничений в течение 30 дней. Получить сейчас
1. Выберите столбец, в котором вы хотите удалить строки, не содержащие определенного текста, и нажмите Кутулс > Выберите Инструменты > Выбрать определенные ячейки. Смотрите скриншот:
2. А в Выбрать определенные ячейки диалог, проверьте Весь рядИ выберите Не содержит, и введите определенный текст в текстовое поле, также вы можете нажать кнопку диапазона в Конкретный тип раздел для выбора ячейки, содержащей определенный текст.
3. Затем нажмите Ok, то выбираются строки, не содержащие определенного текста, щелкните правой кнопкой мыши, чтобы выбрать Удалить из контекстного меню. Смотрите скриншот:
4. Теперь все строки, не содержащие определенного текста в диапазоне, удаляются. Щелкните ее, чтобы получить дополнительную информацию о выборе конкретных ячеек..
Относительные статьи:
- Удалить целые строки, если ячейка не содержит нуля в Excel
- Удалить строки, не соответствующие критериям на другом листе
Как удалить строки по условию?
Предположу, что почти каждый сталкивался с ситуацией, когда необходимо удалить только определенные строки: имеется большая таблица и необходимо удалить из неё только те строки, которые содержат какое-то слово (цифру, фразу). Для выполнения подобной задачи можно воспользоваться несколькими способами.
Способ первый:
Использовать встроенное средство 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, который потребует только указания значения, которое необходимо найти в строке и номер столбца, в котором искать значение.Sub Del_SubStr() Dim sSubStr As String 'искомое слово или фраза(может быть указанием на ячейку) Dim lCol As Long 'номер столбца с просматриваемыми значениями Dim lLastRow As Long, li As Long Dim lMet As Long Dim arr sSubStr = InputBox("Укажите значение, которое необходимо найти в строке", "www.excel-vba.ru", "") If sSubStr = "" Then lMet = 0 Else lMet = 1 lCol = Val(InputBox("Укажите номер столбца, в котором искать указанное значение", "www.excel-vba.ru", 1)) If lCol = 0 Then Exit Sub lLastRow = ActiveSheet.UsedRange.Row - 1 + ActiveSheet.UsedRange.Rows.Count arr = Cells(1, lCol).Resize(lLastRow).Value Application.ScreenUpdating = 0 Dim rr As Range For li = 1 To lLastRow 'цикл с первой строки до конца If -(InStr(arr(li, 1), sSubStr) > 0) = lMet Then If rr Is Nothing Then Set rr = Cells(li, 1) Else Set rr = Union(rr, Cells(li, 1)) End If End If Next li If Not rr Is Nothing Then rr.EntireRow.Delete Application.ScreenUpdating = 1 End Sub
Sub Del_SubStr() Dim sSubStr As String ‘искомое слово или фраза(может быть указанием на ячейку) Dim lCol As Long ‘номер столбца с просматриваемыми значениями Dim lLastRow As Long, li As Long Dim lMet As Long Dim arr sSubStr = InputBox(«Укажите значение, которое необходимо найти в строке», «www.excel-vba.ru», «») If sSubStr = «» Then lMet = 0 Else lMet = 1 lCol = Val(InputBox(«Укажите номер столбца, в котором искать указанное значение», «www.excel-vba.ru», 1)) If lCol = 0 Then Exit Sub lLastRow = ActiveSheet.UsedRange.Row — 1 + ActiveSheet.UsedRange.Rows.Count arr = Cells(1, lCol).Resize(lLastRow).Value Application.ScreenUpdating = 0 Dim rr As Range For li = 1 To lLastRow ‘цикл с первой строки до конца If -(InStr(arr(li, 1), sSubStr) > 0) = lMet Then If rr Is Nothing Then Set rr = Cells(li, 1) Else Set rr = Union(rr, Cells(li, 1)) End If End If Next li If Not rr Is Nothing Then rr.EntireRow.Delete Application.ScreenUpdating = 1 End Sub
Как использовать: Для начала надо убедиться, что разрешены макросы и при необходимости включить их: почему не работает макрос. Затем копируем код выше, из Excel переходим в редактор VBA( Alt + F11 или вкладка Разработчик (Developer) —Visual Basic) —Insert —Module. Вставляем туда скопированный код. Теперь код можно вызывать нажатием клавиш Alt + F8 -выделяем Del_SubStr —Выполнить (Run) .
Если значение sSubStr не будет указано, то будут удалены строки, ячейки указанного столбца которых, пустые.
Если в данном коде в строке If -(InStr(Cells(li, 1), sSubStr) > 0) = lMet Then
вместо = lMet указать <> lMet , то удаляться будут наоборот строки, не содержащие указанное для значение. Иногда тоже удобно.
Но. Данный код просматривает строки на предмет частичного совпадения указанного значения. Например, если Вы укажете текст для поиска «отчет», то будут удалены все строки, в которых встречается это слово(«квартальный отчет», «отчет за месяц» и т.д.). Это не всегда нужно. Поэтому ниже приведен код, который будет удалять только строки, указанные ячейки которых равны конкретно указанному значению:Sub Del_SubStr() Dim sSubStr As String 'искомое слово или фраза(может быть указанием на ячейку) Dim lCol As Long 'номер столбца с просматриваемыми значениями Dim lLastRow As Long, li As Long Dim arr sSubStr = InputBox("Укажите значение, которое необходимо найти в строке", "www.excel-vba.ru", "") lCol = Val(InputBox("Укажите номер столбца, в котором искать указанное значение", "www.excel-vba.ru", 1)) If lCol = 0 Then Exit Sub lLastRow = ActiveSheet.UsedRange.Row - 1 + ActiveSheet.UsedRange.Rows.Count arr = Cells(1, lCol).Resize(lLastRow).Value Application.ScreenUpdating = 0 Dim rr As Range 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 Next li If Not rr Is Nothing Then rr.EntireRow.Delete Application.ScreenUpdating = 1 End Sub
Sub Del_SubStr() Dim sSubStr As String ‘искомое слово или фраза(может быть указанием на ячейку) Dim lCol As Long ‘номер столбца с просматриваемыми значениями Dim lLastRow As Long, li As Long Dim arr sSubStr = InputBox(«Укажите значение, которое необходимо найти в строке», «www.excel-vba.ru», «») lCol = Val(InputBox(«Укажите номер столбца, в котором искать указанное значение», «www.excel-vba.ru», 1)) If lCol = 0 Then Exit Sub lLastRow = ActiveSheet.UsedRange.Row — 1 + ActiveSheet.UsedRange.Rows.Count arr = Cells(1, lCol).Resize(lLastRow).Value Application.ScreenUpdating = 0 Dim rr As Range 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 Next li If Not rr Is Nothing Then rr.EntireRow.Delete Application.ScreenUpdating = 1 End Sub
Здесь так же, как и в случае с предыдущим кодом можно заменить оператор сравнения( 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
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 CStr(arr(li, 1)) = sSubStr Then
заменить на такую:
If InStr(1, arr(li, 1), sSubStr, 1) > 0 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
‘процедура оставляет в листе только те значения, которые перечислены в списке 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
Чтобы код выше сравнивал значения таблицы со значениями списка по точному совпадению слов, а не по частичному, то надо строку:
If InStr(1, arr(li, 1), sSubStr, 1) > 0 Then
If InStr(1, arr(li, 1), sSubStr, 1) > 0 Then