Сравнение элементов двух строк

Question

Я разработал следующий код для сравнения двух ячеек (строк) в столбцах A и D и записи значения D-ячейки в соответствующей B-ячейке, если найдено парное совпадение.

Sub CompareAndGuess() 
Dim strLen, aux As Integer 
Dim max1, max2 As Long 
Dim str As String 

Range("A1").Select 
Selection.End(xlDown).Select 
max1 = ActiveCell.Row 
Range("D1").Select 
Selection.End(xlDown).Select 
max2 = ActiveCell.Row 

For a = 2 To max1 
    str = Cells(a, 1) 
    str = StrConv(str, vbUpperCase) 
    strLen = Len(str) 
    aux = strLen 

    For l = 3 To strLen 
     For d = 2 To max2 
      If Cells(d, 4) = Left(str, aux) Then 
       Cells(a, 2) = Cells(d, 4) 
       Exit For 
      ElseIf Cells(d, 4) = Right(str, aux) Then 
       Cells(a, 2) = Cells(d, 4) 
       Exit For 
      End If 
     Next d 

     aux = aux - 1 
     If Cells(a, 2) <> "" Then 
      Exit For 
     End If 
    Next l 
    Cells(a, 2).Select 
Next a 
End Sub 

Может кто-нибудь помочь мне найти, где это проблема, потому что когда я его запускаю код только угадает правильный один ряд из 50, тогда как он должен соответствовать по крайней мере 40 или около того.

Пожалуйста, я действительно не могу найти ошибку. Не стесняйтесь предлагать другое решение моей проблемы, если хотите.

образец данных я анализирующая является: имен с опечатками: -

Jatiuca 
Pajuara 
Poco 
Santa Luzia 
Pajucara 
Domingos Acacio 
Jaragua 
Stella Maris 
P Verde 
Tabuleiro dos Martin 
Gruta Lourdes 
Brasilia 
Centro Historico 
Monumento 
Tabuleiro dos Martins 

имен с опечатками для поиска по этому списку: -

JARAGUÁ 
TABULEIRO DO MARTINS 
CENTRO 
BRASÍLIA 
CACIMBAS 
JATIÚCA 
CAITITUS 
PAJUÇARA 
CANAÃ 
PONTA VERDE 
CANAFÍSTULA 
POÇO 
CAPIATÃ 
CAVACO 
SANTA LÚCIA 

Answer 1

Я нашел правильный способ сделать это с помощью каждого. Вот оно:

 If InStr(1, Cells(d, 4), Left(str, aux)) = 1 Then 
      Cells(a, 2) = Cells(d, 4) 
      Exit For 
     ElseIf InStr(Cells(d, 4), Right(str, aux)) + strLen - aux = strLen Then 
      Cells(a, 2) = Cells(d, 4) 
      Exit For 
     End If 

Answer 2

Я рад, что вы решили эту проблему самостоятельно с помощью функции InStr. Причина, по которой ваш код плохо работал, заключается в том, что вы сравнивали сокращенные версии имен с полноразмерными версиями. Изменение более раннего кода с помощью следующего поиска позволило бы найти гораздо больше совпадений.

  If Left(Cells(d, 4), aux) = Left(str, aux) Then 
       Cells(a, 2) = Cells(d, 4) 
       Exit For 
      ElseIf Right(Cells(d, 4), aux) = Right(str, aux) Then 
       Cells(a, 2) = Cells(d, 4) 
       Exit For 
      End If 

Answer 3

Это абсолютно UNTESTED

Я буду переписывать завтра, и очистить его, но это основной способ действительно знаю, что вы сопоставляя правильные слова. Это может занять немного больше времени, и я ускорит его МНОГО завтра, но сейчас это шкаф способ проверить слова на валидность

'Go through all possibly typod words 
For each rngTestCell in Range("yourlist") 

    'For each possibly typod word test if against every correct value 
    For each rngCorrectedValue in Range("ListOfCorrectValues") 

     'start by testing length to weed out most values quick 
     'Test any words that are within 3 letters of each other, can be less 
     'could add a tet for first and last letters match also before starting 
     'to match every letter also, just a top level weeding of words 
     If (Len(rngTestCell) - Len(rngCorrectedValue)) < 3 Then 

      'loop each letter in the words for match keep a record of how many are matched 
      for i = 1 to Len(rngTestCell) 

       If rngTestCell.Character(i,1) = rngCorrectedValue.Characters(i,1) Then 
        NumberOfMatches = NumberOfMatches + 1 
       End If 

      next i 

      'if enough of the letters match replace the word, this will need updating because 
      'i feel using a ratio of more then 10% of the words match then replace 
      'but for now if more then 2 letters don't match then it isn't a match 
      If (Len(rngTestCell) - NumberOfMatches) > 2 Then 'Less then 2 letters are different 
       rngTestCell.Offset(,1).Value = rngCorrectedValue.Value 
       Exit Loop 
      End If 

     End If 

    Next rngCorrectedValues 

Next rngTestCell