TOP

LibreOffice için Bulanık Arama Calc

FUZZYLOOKUP() Açıklama

Farklı tablolardaki verileri birleştirmemize yardımcı olan iyi bilinen VLOOKUP() işlevini hepimiz biliyoruz. Ancak bu işlevin önemli bir dezavantajı vardır - benzer değerleri birleştiremez, yani kelimede bir hata varsa eşleşme olmaz.

Yaklaşık değerleri birleştirebilmek için kendi fonksiyonumuzu oluşturabiliriz. Buna FuzzyLokup() adını verelim.

İki listemiz olduğunu düşünelim. Her ikisi de yaklaşık olarak aynı öğelere sahiptir, ancak biraz farklı yazılabilirler. Görev, birinci listedeki her öğe için ikinci listedeki en benzer öğeyi bulmaktır; En yakın maksimum benzer metin için bir arama uygulayın.

Bu durumda asıl soru "benzerlik" kriterinin ne olduğudur. Sadece eşleşen karakterlerin sayısı mı? Ardışık maç sayısı mı? Karakter büyük/küçük harf veya boşluklar dikkate alınmalı mıdır? Bir cümledeki kelimelerin farklı düzenlenişiyle ne yapmalı? Pek çok seçenek var ve tek bir çözüm yok; her durum için biri veya diğeri diğerlerinden daha iyi olacaktır.

Bizim durumumuzda, en basit seçeneği uyguluyoruz - maksimum karakter eşleşmesi sayısına göre arama yapın. Mükemmel değil ama çoğu durumda oldukça iyi çalışıyor.


BASIC işlevi için kod FuzzyLokup

FuzzyLokup işlevini eklemek için Tools - Macros - Edit Macros... menüsünü açın, Module1 öğesini seçin ve aşağıdaki metni modüle kopyalayın:


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
	
    'Arama ifadesindeki her kelimeyi kontrol ediyoruz
    For x = 0 To StrExt 
    
      StrWord = StrArray(x)	  
      If Len(StrWord) = 0 Then GoTo continue_x
	  MaxStrWordRate = 0
	  
      'Bir sonraki hücredeki her kelimeyi orijinal değerler tablosundan kontrol ediyoruz
      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               
        
    'En iyi maçı koruyoruz
    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)	         		        	        
    'Her sembolün oluşumunu arıyoruz
    Position = InStr(1, TargetString, Mid(SourceString, i, 1), 1)  
    'Tesadüf sayacını artırıyoruz
    If Position > 0 Then		  
      Count = Count + 1
      'Bulunan sembolü kaldır
      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

Daha sonra, Macro Editor'u kapatın ve LibreOffice Calc çalışma sayfasına geri dönün - artık yeni FuzzyLokup() işlevimizi kullanabilirsiniz.