比较两个字符串的元素

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

- bruno-martins

---

VB 具有 InStr 函数，这可能会引起您的兴趣... - Mathieu Guindon

是的，我也考虑过那种方法，谢谢你提醒。我会尝试一下，但我仍然想知道我的代码哪里出了问题... - bruno-martins

因为与数字1相似吗？如果是，那很好。谢谢！ - bruno-martins

你能提供一些样本数据和预期结果吗？ - engineersmnky

伙计们，我找到了正确的方法。 我会在这里发布，只是为了向你们所有人和任何谷歌这个问题的人展示。 再次感谢你们所有人！ 尽管我自己想出了方法，但你们真的很有用（尤其是“InStr”提示！！！）。 - bruno-martins

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

- bruno-martins

---

这似乎极不可靠，我错了吗？或者这会替换掉列表中包含单词的前三个或后三个字母的任何单词吗？为什么要循环不同长度，而不是只循环前三个和后三个字母呢？ - user2140261

这似乎并不总是有效。我不仅搜索3个字母，因为找到4、5、6等连续字母比仅找到3个更好，其中两个或更多单词可能有这些3个字母，但没有那些4、5、6等。 - bruno-martins

但它可能会用错误的单词替换错误的单词，因为它确实包含了3，尽管这些名称非常不同。 - user2140261

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

- Graham Anderson

---

我认为这只有在带错别字的单词和不带错别字的单词具有相同的长度时才能起作用，但实际情况并非如此。无论如何感谢您的帮助。 - bruno-martins

@BrunoMartins 只需要比较单词的开头或结尾即可。我在你的示例数据上尝试了一下，它找到了10个匹配项，但没有找到POÇO。 - Graham Anderson

我目前正在使用类似于您在此处发布的内容，但是没有每个比较左侧的“aux”，并且使用了不同的变量，因此我运行所有可能的组合以找到最佳匹配。 - bruno-martins

Answer 3

这绝对是未经测试的

我明天会重写并整理一下，但这是确保您匹配正确单词的基本方法。可能需要更长的时间，而我将在明天加快速度，但现在这是测试单词有效性的最接近的方法。

'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 

- user2140261

---

也许对于匹配语言来说，修改过的Smith-Waterman算法是最好的选择？您可以为每个匹配的字符使用1，为每个不匹配、插入或删除使用-1。但这可能是过度设计的解决方案。 - Graham Anderson

@GrahamAnderson 这个实现非常快，更像是一个概念验证，但目前这是唯一一个不会将“CANAFISTULA”替换为“CANAÔ的答案，尽管“CANAFISTULA”应该被替换为“CANAFÍSTULA”，此外，如果正确的单词“CANAFÍSTULA”在列表中，它将被替换为“CANAÔ，这个例子不会有这个错误。这样做的目的是确保不会错误地替换东西。我不认为这是过度工程化的事情，如果有更简单的方法可以得到相同的结果，那么是的，但这是我能想到的最简单的方法。 - user2140261

我的方法和我怀疑Bruno的方法都不能在正确的列表中使用正确的名称CANAFÍSTULA时将其替换为CANAÃ，这是因为循环在第一个（也是最长的）匹配后终止。我认为你的方法更加健壮。对于过度工程的评论造成的任何冒犯，我感到抱歉，我是想考虑使用Smith-Waterman类型算法。这些通常用于对齐蛋白质或核酸序列。它将测试每对字符串之间的所有可能的完整/部分匹配，因此可能被认为有点过度。 - Graham Anderson