Есть такой вот макрос, который пробегает по документу в поисках четких совпадений условия с текстом в ячейке и заполняет соседние столбцы автоматически. Внимание, вопрос: есть возможность средствами VBA реализовать поиск нечетких вхождений, т.е. при поиске "текст" включать в выборку "текст текст" и т.д., "текстовый текст", по типу работы фильтра: "найти" - "содержит" - "заменить"?
Таких "уникальных", отличающихся ничем с точки зрения логики значений порядка 50 000
Код
Sub magic()
Dim a, b, c As Range
Set a = Range("A1:A30")
For Each b In a
If b.Value2 = "Оригинальный текст" Then Cells(b.Row, "B") = "нашлось"
If b.Value2 = "Тут что-то другое" Then Cells(b.Row, "C") = "тоже нашлось"
If b.Value2 = "А вот тут тоже текст" Then Cells(b.Row, "D") = "и это нашлось, но это же тоже Оригинальный текст"
Next
Set a = Nothing
MsgBox "Все дословные совпадения найдены"
В первой строке таблицы текст: "мама мыла раму", во второй строке таблицы текст "мыла раму мама", мой макрос конкретизирует запрос и ищет фразу "мама мыла раму" целиком, подставляя в соседний столбец первой строки "Нашлось!". Мне же хочется реализовать поиск по части фразы. Для этого конкретного примера обе фразы содержат сочетание "мыла раму". По запросу этого сочетания напротив обеих строк в теории появляется результат - "Нашлось!"
Sub FindMeIfYouCan()
Dim objR As Range, strAddress As String
'определяем диапазон, где будем искать. Определяем через количество строк заполненного диапазона
With Range("A2:A" & Range("A1").CurrentRegion.Rows.Count)
'пихаем в переменную значение метода Find с заданными параметрами (искать содержимое А1, искать в
'значениях, регистр игнорировать.
Set objR = .Find(what:=Range("A1"), LookIn:=xlValues, MatchCase:=False)
'если переменная не пустая (поиск успешен)
If Not objR Is Nothing Then
'пишем в переменную адрес найденной ячейки
strAddress = objR.Address
Do 'пущщаем цикл
objR.Offset(0, 6) = Range("A1") 'отступаем от найденной ячейки 6 столбцов и пишем туда что искали
Set objR = .FindNext(objR) 'через метод FindNext ищем следующую ячейку и пишем в диапазон
Loop While objR.Address <> strAddress 'крутим цикл пока адрес найденной ячейки не равен адресу первой найденной.
End If
End With
End Sub
Пытливый, спасибо за отличный доходчивый пример! Единственное, что не могу, так это подставить вместо искомого значения свой текст, допустим, "содержит"
Код
Do
objR.Offset(0, 6) = Range("A1")
set objR.Value = "содержит"
Вы свой текст запишите в А1, макрос оттуда будет брать значение для поиска. (в моем примере). Пример нарисован для ситуации, что ищем значение ячейки А1 в диапазоне с А2 вниз докуда заполнено. Если нашли значение А1 (игнорируя регистр), то в той же строке где нашли, отступив 6 столбцов пишем значение чего искали.
Вы свой текст запишите в А1, макрос оттуда будет брать значение для поиска
но есть ли возможность вставки не искомого текста, а своего, в контексте Вашего примера?Макрос нашел содержимое "А1" во всех последующих строках, а в "G2:G" помещает сообщение об этом, без дублирования текста запроса в столбец "G"
Цитата
Fuzzy LookUp
Знаю про него, но, к сожалению, умные таблицы не годятся для конкретного конечного пользователя
но, к сожалению, умные таблицы не годятся для конкретного конечного пользователя
В приемах Николай Павлов как раз говорит ...эта надстройка умеет работать только с умными таблицами, поэтому все исходные таблицы нужно конвертировать в умные...
Если делать так, как вы хотите, то надо в этой строке:
Код
objR.Offset(0, 6) = Range("A1") 'отступаем от найденной ячейки 6 столбцов и пишем туда что искали
'написать не что мы искали, а конкретное значение, например:
objR.Offset(0, 6) = "содержит"
Ни тот, ни другой не могут прожевать большие объемы данных в купе с 2013 версией Excel на машине с достаточно неплохой офисной начинкой. Допускаю, конечно, корень проблемы в прокладке между креслом и клавиатурой. Всем спасибо и хорошего дня!