2017-01-30 2 views
0

Я ищу некоторую помощь с кодом для сравнения 2 строк и ранжирования их в соответствии с их соответствием исходным критериям. Код должен игнорировать последовательность. Например, A1 содержит слова «Jon Smith» (исходное значение) и B1 «Smith Jon», которые имеют одинаковый рейтинг. Но если C1 содержит «Jon Smith Junior», это должно иметь более низкий ранг, чем «Джон Смит» или «Смит Джон».Сравнение строк в ячейке вне зависимости от последовательности

Любой может помочь?

+0

Вы хотите «Нечеткий уточняющий запрос» добавить, есть много. У Microsoft есть один. –

+0

Очень полезно знать, спасибо @ScottCraner –

ответ

0

StackOverflow не является кодировкой, и вы должны предоставить свой код, но в этом случае меня заинтересовала эта задача. Вот возможное решение. Запустите checkme - он просто берет две строки и разбивает их на массивы. Затем он подсчитывает, сколько раз значения в arrOne присутствуют в arrTwo. С этой информацией он дает какой-то результат.

Option Explicit 

Public Function CompareTwo(strOne As String, strTwo As String) As Double 

    Dim arrOne  As Variant 
    Dim arrTwo  As Variant 
    Dim varOne  As Variant 
    Dim varTwo  As Variant 

    Dim lngCounter As Long 

    arrOne = Split(strOne) 
    arrTwo = Split(strTwo) 

    For Each varOne In arrOne 
     For Each varTwo In arrTwo 
      If varOne = varTwo Then 
       lngCounter = lngCounter + 1 
      End If 
     Next varTwo 
    Next varOne 

    CompareTwo = lngCounter/(UBound(arrOne) + 1) 

End Function 

Public Sub CheckMe() 

    Debug.Print CompareTwo("Smith Jon", "Jon Smith") 
    Debug.Print CompareTwo("Jon Smith Junior", "Jon Smith") 
    Debug.Print CompareTwo("Jon Smith Junior Ale 6", "Jon Smith Ale 6") 

End Sub 
+0

Это замечательно Vityata, огромное спасибо! Я только начинаю, и я не знал, с чего начать. моя проблема на самом деле немного глубже, чем это. Например, мне нужен способ использования .Dictionary в предлагаемом коде. Например, «Jon Smith II» = «Jon Smith Second» = 1. Есть ли способ добавить дополнительный уровень проверки, чтобы он сравнивал находки «II» = «second». –

+0

В случае 'II' и' Second' простой способ сделать это - ввести «II» в «Второй» в обоих массивах. Взгляните на эту функцию - https://msdn.microsoft.com/en-us/library/bt3szac5(v=vs.90).aspx – Vityata

+0

Спасибо @Vityata. Я могу использовать простую замену, но проблема в том, что это разные для разных имен. поэтому, когда я зацикливаю это на список имен, он не найдет имя «III» как «Третий» или «Jnr» для «Junior» и так далее. Мне нужно сделать varTwo flexible каким-то образом, поэтому он «сопоставляет» строки для списка предварительно отображенных имен. –

0

Я придумал этот. Он создает два массива, один из которых содержит две ключевые имена в данной ячейке в столбце B, а другой - с количеством слов в каждом элементе массива arr1. Затем он отправляет два массива в Sort2 Sub, который был написан участником Gary's Student и может быть найден here. Предполагается, что имена множественного выбора находятся в столбце «B» и что «Jon» и «Smith» жестко закодированы, но могут быть сделаны из другого столбца с небольшим изменением кода.

Колонка B содержит: Джон Смит Смит Джон Младший Смит Джон

Sub create2arr() 
Dim myArr() As Variant, name1 As String, name2 As String, firstMarker As Boolean, myArrayCounter As Long, myArray2Counter As Long 
Dim splitArr() As String, wordCountArr() As Variant 

name1 = "Jon" 
name2 = "Smith" 
ReDim myArr(1 To 1) 
ReDim myArr2(1 To 1) 
ReDim wordCountArr(1 To 1) 

myArrayCounter = 1 
myArray2Counter = 1 

For I = 1 To 3 
    splitArr = Split(Sheet6.Range("B" & I)) 
    For J = LBound(splitArr) To UBound(splitArr) 
     If UCase(splitArr(J)) = UCase(name1) Or UCase(splitArr(J)) = UCase(name2) Then 
       If firstMarker = True Then 
        myArr(myArrayCounter) = Sheet6.Range("B" & I) 
        wordCountArr(myArrayCounter) = UBound(splitArr) + 1 
        myArrayCounter = myArrayCounter + 1 
        ReDim Preserve myArr(1 To myArrayCounter) 
        ReDim Preserve wordCountArr(1 To myArrayCounter) 
        firstMarker = False 
       Else 
        firstMarker = True 
       End If 
     End If 
    Next J 
Next I 

For I = 1 To UBound(myArr) 
Debug.Print myArr(I) 
Next I 

Call sort2(wordCountArr, myArr) 

For I = 1 To UBound(myArr) 
Debug.Print myArr(I) 
Next I 


End Sub 

Sub sort2(key() As Variant, other() As Variant) 
Dim I As Long, J As Long, Low As Long 
Dim Hi As Long, Temp As Variant 
    Low = LBound(key) 
    Hi = UBound(key) 

    J = (Hi - Low + 1) \ 2 
    Do While J > 0 
     For I = Low To Hi - J 
      If key(I) > key(I + J) Then 
      Temp = key(I) 
      key(I) = key(I + J) 
      key(I + J) = Temp 
      Temp = other(I) 
      other(I) = other(I + J) 
      other(I + J) = Temp 
      End If 
     Next I 
     For I = Hi - J To Low Step -1 
      If key(I) > key(I + J) Then 
      Temp = key(I) 
      key(I) = key(I + J) 
      key(I + J) = Temp 
      Temp = other(I) 
      other(I) = other(I + J) 
      other(I + J) = Temp 
      End If 
     Next I 
     J = J \ 2 
    Loop 
End Sub 
Смежные вопросы