Wir alle kennen die bekannte Funktion VLOOKUP(), die uns hilft, Daten aus verschiedenen Tabellen zu kombinieren. Diese Funktion hat jedoch einen wesentlichen Nachteil: Sie kann ähnliche Werte nicht kombinieren, d. h. wenn das Wort einen Fehler enthält, erfolgt keine Übereinstimmung.
Um Näherungswerte kombinieren zu können, können wir eine eigene Funktion erstellen. Nennen wir es FuzzyLookup().
Stellen wir uns vor, wir hätten zwei Listen. Beide haben ungefähr die gleichen Elemente, können aber etwas anders geschrieben sein. Die Aufgabe besteht darin, für jedes Element in der ersten Liste das ähnlichste Element aus der zweiten Liste zu finden, d. h. Implementieren Sie eine Suche nach dem nächstgelegenen maximal ähnlichen Text.
Die große Frage ist in diesem Fall, was unter dem Kriterium „Ähnlichkeit“ zu verstehen ist. Nur die Anzahl übereinstimmender Zeichen? Ist die Anzahl der aufeinanderfolgenden Spiele? Sollten Groß-/Kleinschreibung oder Leerzeichen berücksichtigt werden? Was tun mit unterschiedlicher Anordnung von Wörtern in einer Phrase? Es gibt viele Optionen und es gibt keine einheitliche Lösung – für jede Situation ist die eine oder andere besser als andere.
In unserem Fall implementieren wir die einfachste Option – die Suche nach der maximalen Anzahl von Zeichenübereinstimmungen. Es ist nicht perfekt, funktioniert aber in den meisten Situationen ziemlich gut.
Um die Funktion FuzzyLookup hinzuzufügen, öffnen Sie das Menü Tools - Macros - Edit Macros..., wählen Sie Module1 aus und kopieren Sie den folgenden Text in das Modul:
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
' Wir überprüfen jedes Wort in der Suchphrase
For x = 0 To StrExt
StrWord = StrArray(x)
If Len(StrWord) = 0 Then GoTo continue_x
MaxStrWordRate = 0
' Wir überprüfen jedes Wort in der nächsten Zelle aus der ursprünglichen Wertetabelle
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
' Wir behalten das beste Spiel
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)
' Wir suchen nach dem Vorkommen jedes Symbols
Position = InStr(1, TargetString, Mid(SourceString, i, 1), 1)
' Wir erhöhen den Zähler der Zufälle
If Position > 0 Then
Count = Count + 1
' Entfernen Sie das gefundene 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
Schließen Sie als Nächstes Macro Editor und kehren Sie zum Arbeitsblatt LibreOffice Calc zurück – jetzt können Sie unsere neue Funktion FuzzyLookup() verwenden.
Sie können die Funktion FUZZYLOOKUP() auch verwenden, indem Sie die Erweiterung „ YouLibreCalc.oxt ". Danach ist diese Funktion in allen Dateien verfügbar, die in LibreOffice Calc geöffnet werden.