Vba нечеткий поиск excel

Проблема нечёткого поиска

Когда мы имеем дело с текстом, вводимым человеком, то в нём неизбежны ненамеренные ошибки. Вместо «пер. Гоголя» человек может набрать «пер. Ноголя» просто потому, что промахнётся по нужной клавише и нажмёт соседнюю. В виду этого, возникает задача поставить в соответствие введеному слову слово словарное, которое в наибольшей степени похоже на то, что ввёл пользователь. Классическая задача — верификация названий улиц, населенных пунктов и т.п. Обычный поиск тут бессилен, так как введенное слово в словаре отсутствует. Обычный поиск в состоянии только установить этот факт, но не в состоянии предложить пользователю на выбор наиболее близкие варианты. Нужна реализация нечёткого поиска.

Что я предлагаю

Для тех, кто спешит, сразу сообщаю, что, если тема актуальна, то я предлагаю вам воспользоваться своей пользовательской функцией рабочего листа, которая называется FS_GetClosestWord и имеет 2 обязательных параметра и 4 необязательных.

Формат вызова: =FS_GetClosestWord( What ; Where ; [NumItem] ; [MinLen] ; [Compare] ; [Dbg] ) , где:

• What — ссылка на ячейку, которая содержит искомую строку. Обратите внимание, что текстовая константа в формуле не будет воспринята, только ссылка на ячейку;

• Where — ссылка на диапазон, содержащий словарь, в котором необходимо подобрать наиболее близкое к What слово. Словарь может быть в виде столбца, строки или состоять из произвольного размера диапазона. Имейте только в виду, что, задав словарь из большого количества слов (скажем больше 10000), или, если словарь содержит много очень длинных слов, то вы рискуете надолго подвесить систему;

• [NumItem] — в процессе поиска строится коллекция наиболее подходящих слов, которые ранжируются по определенному алгоритму. NumItem определяет
  номер возвращаемого слова из этой коллеции. NumItem=1 возвращает наиболее близкое по мнению используемого алгоритма слово. Если указанный номер слишком велик и результирующая коллекция не содержит такого числа элементов, то возвращается ошибка #Н/Д;

• [MinLen] — минимальная длинна буквенных комбинаций, на которые разбиваются слова из словаря и, которые потом ищутся в слове из What. Не может быть меньше 3. Если укажете меньше 3 или не укажете вовсе, то будет использовано значение 3;

• [Compare] — тип сравнения строк: с учётом регистра или без учёта. 0 — с учётом регистра, 1 — без учёта регистра;

• [Dbg] — если указать тут число большее 1, то включится режим отладки и в зависимости от того, что вы тут укажаете, сможете получить:

  • 1 — стандартное поведение, возвращающее близкое слово из Where;

  • 2 — найденная подстрока;

  • 3 — слепок найденного словарного слова;

  • 4 — разница по модулю между слепком найденного и искомого слова, которая используется для ранжирования найденных слов по уровню схожести с оригинальным словом (чем меньше разница, тем считаются более похожими слова).

Большинство пользователей обойдутся первыми двумя параметрами.

Скачать файл с функцией

Скачать

Если будете переносить руками в свой Excel VBA проект, то не забудьте помимо модуля Fuzzy, также перенести класс Search.

Теория нечёткого поиска

Изучая вопрос, в начале заглянул к Николаю Павлову в этот его рецепт. Даже нашёл у него ошибки. Однако с самого начало было понятно, что предложенный алгоритм для общего случая будет неприемлем из-за медленной скорости, поэтому изыскания были продолжены. Отличный обзор алгоритмов нечёткого поиска дан в этой статье. Для своей реализации я выбрал метод N-грамм с привлечением хэширования по сигнатуре для оценки найденных вариантов.

Предположим, что у нас в словаре есть слово ПОМИДОР. Мой алгоритм разбивает это слово на подстроки длиной от 7 до 3 символов. 7 — длина слова в данном случае, а комбинации символов короче трёх символов использовать особого смысла нет.

• 7 символов — 1 вариант (ПОМИДОР)

• 6 символов — 2 варианта (ПОМИДО, ОМИДОР)

• 5 символов — 3 варианта (ПОМИД, ОМИДО, МИДОР)

• 4 символа — 4 варианта (ПОМИ, ОМИД, МИДО, ИДОР)

• 3 символа — 5 вариантов (ПОМ, ОМИ, МИД, ИДО, ДОР)

• Итого мы получили из слова ПОМИДОР 15 разных буквенных комбинаций.

Все эти 15 комбинаций я помещаю в словарь. В этот же словарь заносятся все новые комбинации, образующиеся от остальных словарных слов. Далее берётся искомое слово и точно также разбивается на подстроки и прогоняется на совпадение с созданным словарём буквенных комбинаций. Все срабатывания заносятся в коллекцию и ранжируются по уровню похожести.

Проблемы реализации нечёткого поиска

На мой взгляд основная проблема тут — скорость поиска. Надо заметить, что прежде, чем я получил тот код, который вам предлагаю, я написал промежуточную статью про эффективность структур данных и перепробовал массу промежуточных вариантов структур и алгоритмов.

Поскольку всё реализовано в виде формулы рабочего листа, то основной способ улучшить производительность — это, чтобы каждая формула не расчитывала свою коллекцию буквенных комбинаций словаря, а использовала результаты однажды проделанной работы. Это было сделано через глобальные структуры. Однако это всё означает, что формула не отслеживает изменения в массиве Where. То есть считается, что диапазон Where статический и меняется редко.

Надеюсь вы найдёте этот функционал полезным. Если вам данное решение по какой-то причине не подошло или нуждается в серьёзной модификации, то дайте знать, возможно, я его доработаю, так как тема довольно интересная.

Читайте также:

• Извлекаем список уникальных значений из необработанных данных

• Формирование случайных списков на основе справочника

• Расширенное сравнение двух колонок (списков)

Fuzzy text matching is very useful when you want to compare a text string against other strings that don’t have to be identical. You still, however, want to find the one that is closest in terms of words. Fuzzy matching is very useful when e.g. you want to compare a user question against a database of solutions/answers. That is basically what Google does everyday. Rarely will your question ideally match the title of a blog or news article so Google tries to rank pages using fuzzy matching to find ones that are closest to your query.

Microsoft Fuzzy Lookup AddIn

As Fuzzy matching / lookup is a frequent feature Excel users required Microsoft decide to create their own Fuzzy Lookup AddIn. The AddIn basically allows you to lookup columns from another table using Fuzzy Matching and copy them to your source table.

Go here to find Microsoft Official Fuzzy Lookup AddIn for Excel

When playing with the Fuzzy Lookup AddIn I wasn’t happy with it. I had an enormous database of user Questions and Answers and I wanted to have a choice of which items it will match for each of my records basis the user query. Often the fuzzy match algorithm would suggest a match that wasn’t perfect given context. Hence I decide to create my own Fuzzy Match VBA UserForm….

Custom Fuzzy Match using VBA UserForm

What I wanted was an easy way to lookup my query against a Knowledge Base of questions that are ranked in terms of their match against the query. The closer the query is to the question the higher the match. That way I can decide whether indeed I want to take the answer from the question with the highest match rate or maybe one of the below. The additional requirement was to ignore so called “stop words” in my query (the, a, it etc.) as these could generate a lot of false matches, while I wanted fuzzy matching only focus on the keywords.

To show you how the Fuzzy Match VBA UserForm works I created a simple Knowledge Base of Excel/VBA related questions. The KB consists of 3 basis columns: Questions, Answer and Category. The Category column is especially useful as looking at the query you might want to limit the Fuzzy algorithm to run on only a subset of items in your database.

Designing the Fuzzy Match UserForm

Below a quick overview of the Fuzzy Match VBA UserForm if you want to see it in action:

Below you can find the design of the VBA Fuzzy Match UserForm.

Each field is explained below:

• Text Selected – text from the Excel cell you selected in your workbook before running the VBA macro
• Search Question – if you want to override the “Text Selected” field simply type your query here and hit the Search button again. A typical scenario for this field is when you see that the result for your “Text Selected” don’t return satisfactory results and you would like to adjust the query
• Category(s) – if you want to improve the algorithm performance or simply reduce the categories to be searched then select the ones you are interested in
• Search – the Search button will run the algorithm and return results to the “Results” table
• Selected Question / Selected Answer – when you click on one of the results these fields will show the full text of the Question and Answer column. This makes it easier to copy the results where needed

The VBA Code

Initializing the UserForm

Firstly we will initialize our UserForm and assure it is showing us the current list of categories in our “KnowledgeBase” worksheet:

Private Sub UserForm_Initialize()
    Set catDict = GetListofCategories()
    For Each it In catDict.keys
        lbCategory.AddItem it
    Next it
    lbCategory.AddItem "Any"
    For i = 0 To lbCategory.ListCount - 1
        lbCategory.Selected(i) = True
    Next i
    tbSelectedQuestion.Text = Selection.Value
End Sub

Function GetListofCategories()
    Dim question As Range
    Set dict = CreateObject("Scripting.Dictionary")
    Set wsQnA = GetQnAWorksheet
    For Each question In wsQnA.Range("C:C").SpecialCells(xlCellTypeConstants)
        If question.Row > 1 Then
            If Not dict.Exists(question.Value) Then
                dict.Add question.Value, 1
            End If
        End If
    Next question
    Set GetListofCategories = dict
End Function

Function GetQnAWorksheet() As Worksheet
    Dim ws As Worksheet
    For Each ws In ActiveWorkbook.Sheets
        If ws.Name Like "KnowledgeBase*" And ws.Visible Then
            Set GetQnAWorksheet = ws
            Exit Function
        End If
    Next ws
    MsgBox "KnowledgeBase worksheet not found!~", vbCritical + vbOKOnly, "Error"
    Set GetQnAWorksheet = Nothing
End Function

Function for removing Stop Words

Before we focus on generating matches let us focus for a sec on creating a function that will remove stop words from a given sentence. This will help us get rid of all those unnecessary words like “the, it, this” etc. that will dilute the fuzzy algorithm.

Function RemoveStopWords(sentence As String) As Collection
    If IsEmpty(stopWords) Then stopWords = Split("a;about;above;after;again;against;all;am;an;and;any;are;aren't;as;at;be;because;been;before;being;below;between;both;but;by;can't;cannot;chat;could;couldn't;did;didn't;do;does;doesn't;doing;don't;down;during;each;few;for;from;further;had;hadn't;has;hasn't;have;haven't;having;he;he'd;he'll;he's;her;here;here's;hers;herself;hi;him;himself;his;how;how's;i;i'd;i'll;i'm;i've;if;in;into;is;isn't;it;it's;its;itself;let's;me;more;most;mustn't;my;myself;need;needs;no;nor;not;of;off;on;once;only;or;other;ought;our;ours;out;over;own;same;shan't;she;she'd;she'll;she's;should;shouldn't;so;some;such;than;that;that's;the;their;theirs;them;themselves;then;there;there's;these;they;they'd;they'll;they're;they've;this;those;through;to;too;under;until;up;very;was;wasn't;we;we'd;we'll;we're;we've;were;weren't;what;what's;when;when's;where;where's;which;while;who;who's;whom;why;why's;with;won't;would;wouldn't;you;you'd;you'll;you're;you've;your;yours;yourself;yourselves;?;!;" & _
             "-;,;", ";")
    Dim stopR As Range, r As Variant, col As Collection
    Set col = New Collection
    For Each w In Split(sentence, " ")
        If Not (IsNumeric(Trim(w))) Then
            w = Trim(w)
            If Len(w) > 0 Then col.Add w
        End If
    Next w
    For Each r In stopWords
        For i = col.Count To 1 Step -1
            If UCase(col(i)) = UCase(r) Then
                col.Remove i
            End If
        Next i
    Next r
    Set RemoveStopWords = col
End Function

You probably noticed I embedded a lot of words directly in the function. This makes it easy to add or remove stop words quickly.

Fuzzy Matching algorithm

Now for the meaty part :). Below the key logic for generating the results:

Public stopWords As Variant
Dim selectedChat As Range
Private Sub cbSearch_Click()
    'Clear Search worksheet
    Set selectedChat = Selection
    Dim wsRes As Worksheet: Set wsRes = GetSearchWorksheet
    selectedChat.Worksheet.Activate
    'Remove stop words from question
    Dim qCol As Collection
    Set qCol = RemoveStopWords(Selection.Value)
    'Search
    Dim wsQnA As Worksheet, r As Range, saCol As Collection, sa() As String, saIndex As Long
    Dim dict As Object, dstR As Range, startCount As Long, pMax As Long, currProgress As Long
    Set dict = CreateObject("Scripting.Dictionary")
    For i = 0 To lbCategory.ListCount - 1
        If lbCategory.Selected(i) Then
            dict.Add lbCategory.List(i), lbCategory.List(i)
        End If
    Next i
    'Search question matching Service Area, search query and calculate match
    Set wsQnA = GetQnAWorksheet
    If wsQnA Is Nothing Then Exit Sub
    startCount = wsRes.Range("A:A").SpecialCells(xlCellTypeConstants).Count
    pMax = wsQnA.Range("A:A").SpecialCells(xlCellTypeConstants).Count
    For Each r In wsQnA.Range("A:A").SpecialCells(xlCellTypeConstants)
        If dict.Exists(r.Offset(0, 4).Value) Or IsEmpty(r.Offset(0, 4).Value) And r.Row > 1 Then
            If tbSearch.Value = vbNullString Or InStr(1, r.Value, tbSearch.Value, vbTextCompare) > 0 Then
                Set dstR = wsRes.Range("A1").Offset(startCount):  startCount = startCount + 1
                dstR.Value = r.Value
                dstR.Offset(0, 1).Value = r.Offset(0, 1).Value
                dstR.Offset(0, 2).Value = r.Offset(0, 2).Value
                dstR.Offset(0, 3).Value = CalculateMatch(qCol, r.Value)
                dstR.Offset(0, 3).NumberFormat = "0%"
            End If
        End If
        currProgress = currProgress + 1
        If currProgress Mod 100 = 0 Then
            lStatus.Caption = "Searching " & Format(CDbl(currProgress) / pMax, "0%")
            DoEvents
        End If
    Next r
    'Display Search sorted by Match
    If wsRes.UsedRange.Rows.Count > 0 Then
        With wsRes.Sort
            .SortFields.Clear
            .SortFields.Add2 Key:=GetSearchLastColumn(wsRes), SortOn:=xlSortOnValues, Order:=xlDescending, DataOption:=xlSortNormal
            .SetRange wsRes.UsedRange
            .Header = xlYes
            .MatchCase = False
            .Orientation = xlTopToBottom
            .SortMethod = xlPinYin
            .Apply
        End With
    End If
    
    lbResult.RowSource = GetSearchRangeAddress(wsRes)
    lStatus.Caption = "" & lbResult.ListCount & " Questions found"
End Sub
Function GetSearchRangeAddress(ws As Worksheet)
    GetSearchRangeAddress = "'" & ws.Name & "'!" & Range(ws.Range("A2"), ws.Cells(ws.UsedRange.Rows.Count, ws.UsedRange.Columns.Count)).AddressLocal
End Function
Function GetSearchLastColumn(ws As Worksheet) As Range
    Set GetSearchLastColumn = Range(ws.Range("D2"), ws.Cells(ws.UsedRange.Rows.Count, ws.UsedRange.Columns.Count))
End Function

Function CalculateMatch(sentCol As Collection, sentence As String) As Double
    Dim m As Long, s() As String
    s = Split(sentence, " ")
    For Each w In sentCol
        For Each ws In s
            If UCase(ws) = UCase(w) Then
                m = m + 1
                Exit For
            End If
        Next ws
    Next w
    CalculateMatch = m / sentCol.Count
End Function
Sub CreateSearchResultsHeader(ws As Worksheet)
    ws.Range("A1").Value = "Questions"
    ws.Range("B1").Value = "Answer"
    ws.Range("C1").Value = "Category"
    ws.Range("D1").Value = "Match"
End Sub
Sub AddSearchResultsRow(ws As Worksheet, rowNum As Long, question As String, answer As String, sa As String, match As String)
    ws.Range("A" & rowNum).Value = question
    ws.Range("B" & rowNum).Value = answer
    ws.Range("C" & rowNum).Value = sa
    ws.Range("D" & rowNum).Value = match
End Sub
Function GetSearchWorksheet()
    Dim ws As Worksheet
    For Each ws In ActiveWorkbook.Sheets
        If ws.Name = "SearchResults" Then
            ws.UsedRange.Clear
            CreateSearchResultsHeader ws
            Set GetSearchWorksheet = ws
            Exit Function
        End If
    Next ws
    Set ws = ActiveWorkbook.Sheets.Add
    ws.Name = "SearchResults"
    CreateSearchResultsHeader ws
    Set GetSearchWorksheet = ws
End Function

The above code will do the following – compare the query to each question from the selected categories, calculate the match and add it to a temporary worksheet. Once done the table in the form will be connected to the range in the temporary worksheet and displayed.

Below a few other pieces of code that help display the Q/A in the text boxes and help us clean-up:

Private Sub lbResult_Click()
    'Display question and answer in textbox below
    For i = 0 To lbResult.ListCount - 1
        If lbResult.Selected(i) Then
            tbQ.Value = lbResult.List(i, 0)
            tbA.Value = lbResult.List(i, 1)
        End If
    Next i
End Sub

Private Sub UserForm_Terminate()
    On Error Resume Next
    Application.DisplayAlerts = False
    ActiveWorkbook.Sheets("SearchResults").Delete
    Application.DisplayAlerts = True
End Sub

Download the entire VBA Code Module

If you want to download the entire VBA Code Module for the Excel VBA Fuzzy Match UserForm click the download button below:
Download

Like — оператор VBA для сравнения строки с шаблоном. Нечеткий поиск

Подробности

Категория: Основы VBA

Опубликовано: 17 января 2013

Кроме сравнения строк с использованием операторов «равно», «больше» и «меньше», в языке Visual Basic for Applications (VBA) доступен оператор Like, который можно использовать только для сравнения строк.  

Как программно найти и удалить определенные строки в Excel, используя VBA-оператор Like

http://macros-vba.ru/makrosy/excel/132-kak-najti-stroki-v-excel-poisk-strok-slov-i-simvolov-v-excel

Sub Udalenie_Strok_Po_Shablonu()

    Dim r As Long, FirstRow As Long, LastRow As Long

    Dim Region As Range, iRow As Range, Cell As Range

    Dim Shablon As String

    Shablon = "здесь вводится искомый текст"

    Set Region = ActiveSheet.UsedRange

    FirstRow = Region.Row

    LastRow = Region.Row - 1 + Region.Rows.Count 

        For r = LastRow To FirstRow Step -1

        Set iRow = Region.Rows(r - FirstRow + 1)

            For Each Cell In iRow.Cells

                If Cell Like Shablon Then

                    Rows(r).Delete

                End If

            Next Cell

        Next r

End Sub

Сравнение строки с шаблоном

Оператор Like выполняет особый тип операции сравнения строк, определяя совпадает ли строка с заданным образцом (шаблоном). Этот оператор используется также для поиска в текстовой информации слов, фраз и определенных символов, совпадающих с заданным шаблоном. Такой тип поиска часто называют нечетким поиском.

Специальные символы совпадения с образцом для оператора Like

Образец, с которым должна сравниваться строка, задается при помощи различных специальных символов, представленных в таблице ниже.

Использование символов совпадения рассмотрим на примере процедуры, удаляющей всю строку активного рабочего листа, при нахождении в этой строке ячейки с искомым текстом (шаблоном).

Если Shablon=»*Круг 2#*», то на листе будут удалены все строки, в которых найдутся слова «Круг 20», «Круг 25» и так далее.

Если Shablon=»S*e», то на листе будут удалены все строки, в ячейках которых будут найдены слова «Sadie», «Salone», «Sophie», «Steve» и так далее.

Если Shablon=»P???y», то удалены будут строки со словами «Penny», «Persy», «Patty» и так далее.

Две последние спецификации символов совпадения из вышеприведенной таблицы используются для указания отдельных символов, совпадение или несовпадение с которыми нужно при поиске. Ниже приведены выражения, использующие квадратные скобки с символьным списком.

Если Shablon=»bi[dg]», то строки со словами в ячейках «bid» и «big» будут удалены, а со словами «bit» и «bin» останутся нетронутыми.

Если же Shablon=»bi[!dg]», то результат будет обратным.

Квадратные скобки можно также использовать для указания диапазона символов, совпадение или несовпадение с которыми необходимо, например Shablon=»ci[a-f]» или Shablon=»ci[!a-f]». В таких случаях диапазоны необходимо указывать от наименьшего до наибольшего символа. Квадратные скобки, в которых ничего не заключено — VBA игнорирует.

Квадратные скобки используются и в тех случаях, когда необходимо сами специальные символы сделать частью шаблона. Например, для того чтобы найти все строки, заканчивающиеся вопросительным знаком, необходимо задать шаблон следующим образом: Shablon=»*[?]».

Для совпадения со знаком дефиса в строке шаблона, дефис помещается в начало или в конец списка символов внутри квадратных скобок. Дефис, помещенный в любое другое место, задает диапазон символов.

Если Shablon=»*g[-]*», то совпадениями будут считаться выражения «big-headed», «plug-ugly», «tag-along» и так далее.

Результат сравнения строк VBA-оператором Like зависит от инструкции Option Compare. При двоичном сравнении оператор различает буквы верхнего и нижнего регистра, а при текстовом — нет.

Другие материалы по теме:

• MsgBox — оператор VBA для вывода сообщений пользователю процедуры
• Как удалить скрытые строки? Программное удаление скрытых строк макросом VBA.
• Как удалить пустые строки? Программное удаление пустых строк макросом VBA
• Как вставить/добавить новые/пустые строки в Excel?
• Как удалить строки в Excel по условию? Удаление и скрытие пустых строк и строк, содержащих заданное значение

Кроме сравнения строк с использованием операторов «равно», «больше» и «меньше», в языке Visual Basic for Applications (VBA) доступен оператор Like, который можно использовать только для сравнения строк.  

Сравнение строки с шаблоном

Оператор Like выполняет особый тип операции сравнения строк, определяя совпадает ли строка с заданным образцом (шаблоном). Этот оператор используется также для поиска в текстовой информации слов, фраз и определенных символов, совпадающих с заданным шаблоном. Такой тип поиска часто называют нечетким поиском.

Специальные символы совпадения с образцом для оператора Like

Образец, с которым должна сравниваться строка, задается при помощи различных специальных символов, представленных в таблице ниже.

Использование символов совпадения рассмотрим на примере процедуры, удаляющей всю строку активного рабочего листа, при нахождении в этой строке ячейки с искомым текстом (шаблоном).

Если Shablon=»*Круг 2#*», то на листе будут удалены все строки, в которых найдутся слова «Круг 20», «Круг 25» и так далее.

Если Shablon=»S*e», то на листе будут удалены все строки, в ячейках которых будут найдены слова «Sadie», «Salone», «Sophie», «Steve» и так далее.

Если Shablon=»P???y», то удалены будут строки со словами «Penny», «Persy», «Patty» и так далее.

Две последние спецификации символов совпадения из вышеприведенной таблицы используются для указания отдельных символов, совпадение или несовпадение с которыми нужно при поиске. Ниже приведены выражения, использующие квадратные скобки с символьным списком.

Если Shablon=»bi[dg]», то строки со словами в ячейках «bid» и «big» будут удалены, а со словами «bit» и «bin» останутся нетронутыми.

Если же Shablon=»bi[!dg]», то результат будет обратным.

Квадратные скобки можно также использовать для указания диапазона символов, совпадение или несовпадение с которыми необходимо, например Shablon=»ci[a-f]» или Shablon=»ci[!a-f]». В таких случаях диапазоны необходимо указывать от наименьшего до наибольшего символа. Квадратные скобки, в которых ничего не заключено — VBA игнорирует.

Квадратные скобки используются и в тех случаях, когда необходимо сами специальные символы сделать частью шаблона. Например, для того чтобы найти все строки, заканчивающиеся вопросительным знаком, необходимо задать шаблон следующим образом: Shablon=»*[?]».

Для совпадения со знаком дефиса в строке шаблона, дефис помещается в начало или в конец списка символов внутри квадратных скобок. Дефис, помещенный в любое другое место, задает диапазон символов.

Если Shablon=»*g[-]*», то совпадениями будут считаться выражения «big-headed», «plug-ugly», «tag-along» и так далее.

Результат сравнения строк VBA-оператором Like зависит от инструкции Option Compare. При двоичном сравнении оператор различает буквы верхнего и нижнего регистра, а при текстовом — нет.

Here is a VBA solution which implements a rather weak fuzzy lookup. Maybe it will work on a Mac, maybe not (I’ve had mixed experiences when a colleague who has a Mac has tried to run some of my programs):

Function FLOOKUP(pat As String, arr As Variant, ColNum As Long, Optional CaseSensitive = True) As Variant
    'does a linear search of first column of array or range arr until it finds a
    'string which is a fuzzy match for pat, returning the corresponding
    'entry in column ColNum of arr. If no match is found NA is returned

    Dim A As Variant, i As Long, s As String, p As String, pStar As String

    p = IIf(CaseSensitive, pat, UCase(pat))
    pStar = "*" & p & "*"

    If TypeName(arr) = "Range" Then
        A = arr.Value
    Else
        A = arr
    End If

    For i = LBound(A) To UBound(A)
        s = A(i, 1)
        If Not CaseSensitive Then s = UCase(s)
        If p Like "*" & s & "*" Or s Like pStar Then
            FLOOKUP = A(i, ColNum)
            Exit Function
        End If
    Next i

    FLOOKUP = CVErr(xlErrNA)
End Function

In this code s is considered to be a fuzzy match of t if and only if either s Like "*" & t & "*" or t Like "*" & s & "*". In other words, if either s is a substring of t or vice-versa.

If Excel VBA for the Mac doesn’t know about xlErrNA, experimentation suggests that this is just 2042. You could always return e.g. False rather than an error code if no match is found.

The linear nature of the search implies that it probably won’t scale very well, but perhaps it will work for your application.

Оригинальный официальный аккаунт WeChat

Система: Windows 7
Программное обеспечение: Excel 2010 / Access 2010

• Новая глава в этой серии, посвященная базе данных Access.
• Основной фрейм: Excel как рабочий интерфейс, Access как база данных
• Поговорим о нечетком запросе сегодня
• Вовлеченные знания:ADO，SQL：like

Часть 1: Цель

Список товаров

1. в соответствии сИдентификатор товараНайдите необходимые продукты
2. Реализовано нечетким поиском, немногоBaiduВкус, знать только часть информации, чтобы узнать
3. Логический процесс
   • Подключиться к базе данных
   • Определите оператор SQL в соответствии с потребностями
   • Выполните инструкцию SQL, получитеrecordset
   • будуrecordsetЗапишите в рабочий лист (название поля + все записикоторый Название столбца + каждая строка)
   • Отключиться от базы данных
4. ПоискИдентификатор товараПервая букваmпродукт

Часть 2: Код

Sub test()
    Dim cnn As New ADODB.Connection 'связь
    Dim rs As New ADODB.Recordset
    Dim SQL As String
    Dim tblName
    Dim dbAddr

    dbAddr = ThisWorkbook.Path & " Product List.accdb"
    tblName = "Список продуктов"

    'Подключиться к базе данных
    With cnn
        .Provider = "Microsoft.ACE.OLEDB.12.0"
        .Open "Data Source=" & dbAddr
    End With

    opFilds = «Код товара, название товара, производитель, количество»
    searchC = «Идентификатор продукта вроде'm% '»

    SQL = "Select " & opFilds & " from " & tblName & " where (" & searchC & ")"
    Set rs = cnn.Execute(SQL)

    Dim sht
    Dim fildNum

    Set sht = ThisWorkbook.Worksheets("Пример")
    sht.Cells.ClearContents

    fildNum = rs.Fields.Count
    For j = 0 To fildNum - 1 Step 1
        fildName = rs.Fields(j).Name
        sht.Cells(1, j + 1) = fildName
    Next j

    sht.Cells(2, 1).CopyFromRecordset rs

    cnn.Close
    Set rs = Nothing
    Set cnn = Nothing

End Sub

Скриншот кода

Результаты

Часть 3: Часть интерпретации кода

1. Выберите идентификатор продукта, название продукта, производителя, количество из списка продуктов, где (идентификатор продукта, например 'm%')
2. Толкование на китайском: выберите встречуИдентификатор товараПервая цифра — это буква м с информацией о продукте. В результатеБез различияДело
3. Такой%Представляет 0 или любой символ, немного похожий на*Роль

Часть 4: Расширение

1. _Представляет одиночный символ,searchC = "Идентификатор продукта, например '____'"，Четыре символа подчеркивания, Результаты приведены ниже

1. []Укажите диапазон,searchC = "Идентификатор продукта, например '[0-9]%'", Что означает строку, начинающуюся с 0-9, результат будет следующим

1. [ ]Укажите диапазон,searchC = "Идентификатор продукта, например '[a-z]%'", Представляет строку, начинающуюся с букв a-z, без учета регистра, результат будет следующим

1. [!]За пределами указанного диапазона,searchC = "Идентификатор продукта, например '[! a-z]%'", Что означает, что он не начинается с a-z, результат будет следующим
   

2. not likeОтрицать,searchC = "Идентификатор продукта не похож на '[a-z]%'", Представляет строку, начинающуюся с букв a-z, без учета регистра, результат будет следующим

Эта статья — оригинальная работа, если вам нужно перепечатать, вы можете добавить аккаунт редактора WeChat.learningBin

Выше приведены учебные материалы, увидимся в следующий раз

Если будут обнаружены какие-либо ошибки, пожалуйста, оставьте сообщение, чтобы указать

Еще интереснее, обратите внимание на публичный аккаунт WeChat
Отсканируйте QR-код и подпишитесь на этот официальный аккаунт