Всі ми знаємо добре відому функцію VLOOKUP(), яка допомагає нам поєднувати дані з різних таблиць. Проте дана фунція має один суттєвий недолік - вона не може поєднувати подібні значення, тобто якщо в слові допущена помилка - то співпадіння вже не буде.
Щоби мати можливість поєднувати приблизні значення ми можемо створити власну функцію. Давайте назвемо її FuzzyLookup().
Уявимо, що ми маємо два списки. І в тому, і в іншому приблизно одні й самі елементи, але записані вони можуть бути трохи по-різному. Завдання - підібрати кожному елементу у першому списку максимально схожий елемент із другого списку, тобто. реалізувати пошук найближчого максимально схожого тексту.
Велике питання, в даному випадку, що вважати критерієм "схожості". Просто кількість символів, що збігаються? Чи кількість збігів, що йдуть поспіль? Чи враховувати регістр символів або пробіли? Що робити з різним розташуванняи слів у фразі? Варіантів багато і однозначного рішення немає - для кожної ситуації той чи інший буде кращим за інших.
В нашому випадку ми реалізуємо найпростіший варіант - пошук за максимальною кількістю збігів символів. Він не є ідеальним, але для більшості ситуацій працює цілком надійно.
Щоб додати функцію FuzzyLookup, відкрийте меню Tools - Macros - Edit Macros..., виберіть Module1 і скопіюйте наведений нижче текст до модуля:
Function FuzzyLOOKUP(LookupValue As String, SrcTable As Variant, Optional SimThreshold As Single) As String
'moonexcel.com.ua
Dim Str As String
Dim CellArray As Variant
Dim StrArray As Variant
If IsMissing(SimThreshold) Then SimThreshold = 0
Str = LCase(LookupValue)
StrArray = Split(Str)
StrExt = UBound(StrArray)
For Each Cell In SrcTable
CellArray = Split(LCase(Cell))
CellExt = UBound(CellArray)
CellRate = 0
'Перевіряємо кожне слово в пошуковій фразі
For x = 0 To StrExt
StrWord = StrArray(x)
If Len(StrWord) = 0 Then GoTo continue_x
MaxStrWordRate = 0
'Перевіряємо кожне слово в черговій комірці з вихідної таблиці значень
For i = 0 To CellExt
CellWord = CellArray(i)
If Len(CellWord) = 0 Then GoTo continue_i
FindCharNum = OccurrenceNum(StrWord, CellWord)
StrWordRate = FindCharNum / Max(Len(StrWord),Len(CellWord))
If StrWordRate > MaxStrWordRate Then MaxStrWordRate = StrWordRate
continue_i:
Next i
CellRate = CellRate + MaxStrWordRate
continue_x:
Next x
'Зберігаємо найкраще співпадіння
If CellRate > MaxCellRate Then
MaxCellRate = CellRate
BestCell = Cell
FindCharNum = OccurrenceNum(Str, Cell)
SimRate = FindCharNum / Max(Len(Str),Len(Cell))
End If
Next Cell
IF SimRate >= SimThreshold Then
IF SimThreshold = -1 Then
ReturnValue = BestCell + " (" + Format(SimRate, "0.00") + ")"
ElseIf SimThreshold = -2 Then
ReturnValue = Format(SimRate, "0.00")
Else
ReturnValue = BestCell
End If
Else
ReturnValue = ""
End If
FuzzyLOOKUP = ReturnValue
End Function
Function OccurrenceNum(ByVal SourceString As String, ByVal TargetString As String)
For i = 1 To Len(SourceString)
'Шукаємо входження кожного символу
Position = InStr(1, TargetString, Mid(SourceString, i, 1), 1)
'Збільшуємо лічильник співпадінь
If Position > 0 Then
Count = Count + 1
'Вилучаємо знайдений символ
TargetString = Left(TargetString, Position - 1) + Right(TargetString, Len(TargetString) - Position)
End If
Next i
OccurrenceNum = Count
End Function
Function Max(ByVal value1 As Variant, ByVal value2 As Variant)
If value1 > value2 Then
Result = value1
Else
Result = value2
End If
Max = Result
End Function
Далі, закрийте Macro Editor та поверніться на робочий аркуш LibreOffice Calc - тепер ви можете скористатись нашою новою функцією FuzzyLookup().