Левенштейн Vlookup; Нахождение наименьшего процентного соответствия левенштейна в диапазоне и вывод другого столбца - PullRequest
Новая
       20

Левенштейн Vlookup; Нахождение наименьшего процентного соответствия левенштейна в диапазоне и вывод другого столбца

0 голосов
/ 04 февраля 2020

Я пытаюсь сделать то, что я называю levenshtein vlookup, что похоже на «нечеткое совпадение». Я хочу сослаться на ячейку в A1 с текстом в ней, найти ячейку в весь столбец диапазон B: B с наименьшим номером Левенштейна и вывести строку в C: C, где это самое низкое матч Левенштейна был найден. Код ниже взят из этого блога , в котором был слегка отредактирован код из обсуждения stackoverflow .

Моя самая большая проблема с этим кодом заключается в том, что он работает только с 11034 строками (ie, B1: B11034). Как только он достигает 11035, я получаю ошибку #Value. У меня умеренный опыт работы с VBA, я просмотрел код, и, похоже, никаких взлетов t ie, я думаю, это должен быть какой-то другой аппаратный / VBA предел, с которым я не знаком. Кто-нибудь может дать представление об этом? Есть ли какое-то исправление или мне нужно переместить это в R или что-то в этом роде?

Второй, менее важный вопрос, Levenstein "Fuzzy" Vlookup, кажется, работает, только если диапазон поиска находится на том же листе и нет в столбце А. Видите ли вы что-нибудь в коде, почему это так? Я хотел бы сослаться на другой лист в диапазоне поиска. 

    Option Explicit

' Levenshtein3 tweaked for UTLIMATE speed and CORRECT results
' Solution based on Longs
' Intermediate arrays holding Asc()make difference
' even Fixed length Arrays have impact on speed (small indeed)
' Levenshtein version 3 will return correct percentage(0...100)

Function FuzzyPercent(ByVal String1 As String, ByVal String2 As String) As Long

Dim I As Long, j As Long, string1_length As Long, string2_length As Long
Dim distance(0 To 60, 0 To 50) As Long, smStr1(1 To 60) As Long, smStr2(1 To 50) As Long
Dim min1 As Long, min2 As Long, min3 As Long, minmin As Long, MaxL As Long

string1_length = Len(String1):  string2_length = Len(String2)

distance(0, 0) = 0
For I = 1 To string1_length:    distance(I, 0) = I: smStr1(I) = Asc(LCase(Mid$(String1, I, 1))): Next
For j = 1 To string2_length:    distance(0, j) = j: smStr2(j) = Asc(LCase(Mid$(String2, j, 1))): Next
For I = 1 To string1_length
    For j = 1 To string2_length
        If smStr1(I) = smStr2(j) Then
            distance(I, j) = distance(I - 1, j - 1)
        Else
            min1 = distance(I - 1, j) + 1
            min2 = distance(I, j - 1) + 1
            min3 = distance(I - 1, j - 1) + 1
            If min2 < min1 Then
                If min2 < min3 Then minmin = min2 Else minmin = min3
            Else
                If min1 < min3 Then minmin = min1 Else minmin = min3
            End If
            distance(I, j) = minmin
        End If
    Next
Next

' Levenshtein3 will properly return a percent match (100%=exact) based on similarities and Lengths etc...
MaxL = string1_length: If string2_length > MaxL Then MaxL = string2_length
FuzzyPercent = 100 - CLng(distance(string1_length, string2_length) * 100 / MaxL)

End Function


Function FuzzyVLookup(ByVal LookupValue As String, _
                      ByVal TableArray As Range, _
                      ByVal ValIndex As Integer, _
                      Optional ValIndex1 As Integer) As Variant

'********************************************************************************
'**This function must be called by selecting three columns then entering the function and pressing ctrl+shift+enter**'
'**this function compares the LookUpValue with the values in 1st column of TableArray range and returns the        **'
'**values from columns valIndex, ValIndex1 from the range and also percentage match                                **'

'**LookupValue: the value for which a match is to be found in a range of values**'
'**TableArray: the range in which the match for LookUpValue is to be found     **'
'**ValIndex: index of a column in TableArray range whose value is to be retrieved on match**'
'**ValIndex1: (optional) additional index of a column in TableArray range  whose value is to be retrieved on match**'


Dim R As Range

Dim strListString As String
Dim strWork As String
Dim I As Integer
Dim lEndRow As Long

Dim Row As Integer
Dim sngCurPercent  As Long
Dim sngMinPercent As Long
Dim arr As Variant
'--------------------------------------------------------------
'--    Validation                                            --
'--------------------------------------------------------------
ReDim arr(1 To 5)
Row = 0
sngMinPercent = 0

lEndRow = TableArray.Rows.Count
If VarType(TableArray.Cells(lEndRow, 1).Value) = vbEmpty Then
    lEndRow = TableArray.Cells(lEndRow, 1).End(xlUp).Row
End If

'---------------
'-- Main loop --
'---------------
For Each R In Range(TableArray.Cells(1, 1), TableArray.Cells(lEndRow, 1))

    strListString = R.Offset(0, 0).Text 'the city name in the range is in column 0

    '------------------------------------------------
    '-- Fuzzy match strings & get percentage match --
    '------------------------------------------------
    sngCurPercent = FuzzyPercent(String1:=LookupValue, _
                                 String2:=strListString)

    If sngCurPercent >= sngMinPercent Then
        Row = R.Row
        sngMinPercent = sngCurPercent
    End If

Next R

'-----------------------------------
'-- Return column entry specified --
'-----------------------------------
arr(1) = TableArray.Cells(Row, ValIndex) 'return the column value for matched row at ValIndex
arr(2) = TableArray.Cells(Row, ValIndex1) 'return the column value for matched row at ValIndex1
arr(3) = sngMinPercent 'return the match % for matched row
FuzzyVLookup = arr


End Function
...