比较两个string的元素

我已经开发了以下代码来比较列A和D中的两个单元格（string），并记下相应B单元格中的D单元格值（如果find部分匹配）。

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 

任何人都可以帮助我find问题的原因，因为当我运行它时，代码只能猜出50行中的一行，而它应该至less匹配40个左右。

请，我真的找不到那里的错误。 随意提出另一个解决scheme，如果你想我的问题。

我要分析的数据样本是：有错别字的名称： –

 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 

在此列表中search错别字的名称： –

 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

我已经find了正确的方式来与大家的帮助。 这里是：

  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

这是绝对的

我会明天重写，并清理它，但这是真正知道你匹配正确的单词的基本方法。 这可能需要一点点时间，我会明天加快速度，但现在这是testing有效性的最好方法

 '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