정확히 일치하는 루프를 반환하지만 유사한 일치를 반환하도록 업데이트해야합니다

Question

셀 C3에서 사용자 입력을 할 때 완벽하게 작동하는 기존 코드가 있으며 그 아래에있는 데이터 테이블을 검색하고 상단에 제품 코드에 대한 모든 일치하는 결과를 깔끔하게 표시합니다 행이 거의 없습니다. 이 코드를 업데이트하여 정확한 일치 항목을 찾을 수없는 이벤트의 일부 로직을 포함해야하지만 비슷한 일치 항목을 발견했을 수 있습니다. 정확하게 일치가 발견되지 않는 경우

Option Compare Text 
    Sub MultipleLkp() 

    Dim numRows As Integer, numCols As Integer, i As Integer, j As Integer, k As Integer, PrimKey, lastColumn As Long 
    Dim Trimkey As String 


    Application.ScreenUpdating = False 
    Worksheets("DashboardMain").Range("D3:R8").ClearContents 
    Worksheets("DashboardMain").Range("C200").CurrentRegion.Select 
    PrimKey = Worksheets("DashboardMain").Range("C3").Value 
    numRows = Selection.Rows.Count 
    numCols = Selection.Columns.Count 
    j = 2 
    lastColumn = Cells.Find(What:="*", After:=Range("A1"), Lookat:=xlPart, LookIn:=xlFormulas, SearchOrder:=xlByColumns, SearchDirection:=xlPrevious, MatchCase:=False).Column 

    'TrimKey is the variable replacing PrimKey but without spaces or hyphens. 
    'allows user to input a model with or without " " or "-" in cell C3 
    'can be modified to include more invalid characters 
    Trimkey = Replace(Replace(PrimKey, " ", ""), "-", "") 
    If Trimkey = "" Then 
    Exit Sub 
    End If 
    'runs the loop and returns all matches; displays matches in rows 3 down until all matches found 
    'does not have any logic if no match is found. need to add the "like" function? 
    For i = 2 To numRows 
     If Worksheets("DashboardMain").Cells(199 + i, 3).Value = Trimkey Then 
      j = j + 1 
      For k = 1 To lastColumn 
       Worksheets("DashboardMain").Cells(j, 3 + k).Value = Worksheets("DashboardMain").Cells(199 + i, 3 + k).Value 
      Next k 
     End If 
    Next I 
end sub 

이상적으로, 메시지 상자가 가능한 일치를 보여 것이라고 표시 할 다음 사용자가 잠재적 인 일치를 선택할 수 있습니다, 다음으로 같은 지역에 따라 표시 할 것입니다 : 여기에 기존의 코드는 정확히 일치하는 것처럼 어떤 도움도 감사하겠습니다.

Answer 1

글쎄, 내 특별한 엑셀 addin에는 몇 가지 특별한 기능이 있습니다. 하나 많은 변화 (삭제, 교체)을 측정한다 LEVEN은 Levenshtein의 algorythm을 기반으로

Public Function LEVEN(s1 As String, s2 As String) As Integer 
    If Len(s1) > Len(s2) Then 
     LEVEN = Levenshtein(s1, s2) 
    Else 
     LEVEN = Levenshtein(s2, s1) 
    End If 

End Function 

Private Function Levenshtein(s1 As String, s2 As String) As Integer 

Dim i As Integer 
Dim j As Integer 
Dim l1 As Integer 
Dim l2 As Integer 
Dim d() As Integer 
Dim min1 As Integer 
Dim min2 As Integer 

l1 = Len(s1) 
l2 = Len(s2) 
ReDim d(l1, l2) 
For i = 0 To l1 
    d(i, 0) = i 
Next 
For j = 0 To l2 
    d(0, j) = j 
Next 
For i = 1 To l1 
    For j = 1 To l2 
     If Mid(s1, i, 1) = Mid(s2, j, 1) Then 
      d(i, j) = d(i - 1, j - 1) 
     Else 
      min1 = d(i - 1, j) + 1 
      min2 = d(i, j - 1) + 1 
      If min2 < min1 Then 
       min1 = min2 
      End If 
      min2 = d(i - 1, j - 1) + 1 
      If min2 < min1 Then 
       min1 = min2 
      End If 
      d(i, j) = min1 
     End If 
    Next 
Next 
Levenshtein = d(l1, l2) 
End Function 

다른 하나의 텍스트를 변환하기 위해 수행해야합니다. 이 함수는 두 문자열 사이의 거리를 측정합니다. 따라서 boolExact와 같은 부울 변수를 추가하면

If Worksheets("DashboardMain").Cells(199 + i, 3).Value = Trimkey Then 

이 충족되면 TRUE가됩니다. 하지 boolExact는, 만약 그렇다면, 실행 서브 루틴이 간단한 솔루션은

if LEVEN(Worksheets("DashboardMain").Cells(199 + i, 3).Value, TrimKey)>3 

입니다 확인 것이라고한다면 다음 설정 조건부 명령은 검사합니다. 두 문자 단어는 서로 최대로 두 단계이므로 LEVEN은 2를 반환합니다. LEVEN (x, y)/max (LEN (x), LEN (y))와 비교하면 유용한 거리를 측정 할 수 있습니다.