Wszyscy znamy dobrze znaną funkcję VLOOKUP(), która pomaga nam łączyć dane z różnych tabel. Funkcja ta ma jednak jedną istotną wadę - nie może łączyć podobnych wartości, to znaczy, jeśli w słowie wystąpi błąd, wówczas nie będzie dopasowania.
Aby móc łączyć wartości przybliżone, możemy stworzyć własną funkcję. Nazwijmy to FuzzyLookup().
Wyobraźmy sobie, że mamy dwie listy. Oba mają w przybliżeniu te same elementy, ale mogą być napisane nieco inaczej. Zadanie polega na znalezieniu dla każdego elementu z pierwszej listy najbardziej podobnego elementu z drugiej listy, tj. zaimplementuj wyszukiwanie najbliższego maksymalnie podobnego tekstu.
Najważniejszym pytaniem w tym przypadku jest to, co należy uznać za kryterium „podobieństwa”. Tylko liczba pasujących znaków? Czy liczba kolejnych meczów? Czy należy wziąć pod uwagę wielkość znaków czy spacje? Co zrobić z innym ułożeniem słów w zdaniu? Opcji jest wiele i nie ma jednego rozwiązania – w każdej sytuacji jedno lub drugie będzie lepsze od innych.
W naszym przypadku wdrażamy najprostszą opcję - wyszukiwanie po maksymalnej liczbie dopasowań znaków. Nie jest to rozwiązanie idealne, ale w większości sytuacji sprawdza się całkiem nieźle.
Dodać funkcja FuzzyLookup , otwórz menu Tools - Macros - Edit Macros... , wybierać Moduł1 i skopiuj następujący tekst do modułu:
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
' Sprawdzamy każde słowo w wyszukiwanej frazie
For x = 0 To StrExt
StrWord = StrArray(x)
If Len(StrWord) = 0 Then GoTo continue_x
MaxStrWordRate = 0
' Sprawdzamy każde słowo w następnej komórce z oryginalnej tabeli wartości
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
' Utrzymujemy najlepszy mecz
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)
' Szukamy wystąpienia każdego symbolu
Position = InStr(1, TargetString, Mid(SourceString, i, 1), 1)
' Zwiększamy licznik zbiegów okoliczności
If Position > 0 Then
Count = Count + 1
' Usuń znaleziony symbol
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
Dalej, zamknij Macro Edytor i wróć do arkusza LibreOffice Calc - teraz możesz korzystać z naszej nowej funkcji FuzzyLookup() .
Możesz także skorzystać z tej funkcji FUZZYLOOKUP() instalując darmowe rozszerzenie YouLibreCalc.oxt lub jego w pełni funkcjonalna wersja YLC_Utilities.oxt .
Od tego momentu ta funkcja będzie dostępna we wszystkich plikach, które zostaną otwarte w LibreOffice Calc.