TOP

LibreOffice の あいまい検索 Calc

FUZZYLOOKUP()

さまざまなテーブルのデータを結合するのに役立つよく知られた VLOOKUP() 関数は誰もが知っています。ただし、この関数には重大な欠点が 1 つあります。類似した値を組み合わせることができないということです。つまり、単語にエラーがある場合は一致しません。

近似値を組み合わせるために、独自の関数を作成できます。これを FuzzyLookup() と呼びましょう。

2 つのリストがあると想像してみましょう。どちらもほぼ同じ要素を持っていますが、書き方が若干異なる場合があります。タスクは、最初のリストの各要素について、2 番目のリストから最も類似した要素を見つけることです。最も近い、最大限に類似したテキストの検索を実装します。

この場合の大きな問題は、「類似性」の基準を何を考慮するかということです。一致する文字の数だけですか?連続試合数ですか?大文字と小文字またはスペースを考慮する必要がありますか?フレーズ内の単語の配置が異なる場合はどうすればよいでしょうか?多くのオプションがあり、単一の解決策はありません。状況ごとに、どちらか一方が他よりも優れています。

この例では、最も単純なオプション、つまり一致する文字の最大数で検索するオプションを実装します。完璧ではありませんが、ほとんどの状況でかなりうまく機能します。


BASIC 関数 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() 関数を使用できるようになります。