Question

我的经理告诉我，有一种方法可以评估拼写不同但名称与发音方式相似的名称。理想情况下，我们希望能够评估用户输入的搜索名称并返回完全匹配以及“类似的声音”名称。他把这个过程称为“Soundits”，但我在Google上找不到任何信息。

这是否存在？有谁知道它是否可用于VBA（Access）？

Answer 1

好问题！你的问题包括这个想法本身的一个很好的例子。

有一种称为Russell Soundex 算法的算法，这是许多应用程序中的标准技术，它通过语音而不是实际拼写来评估名称。在这个问题中， Soundits 和 Soundex 是类似的名字！ [编辑：刚跑了Soundex。 Soundits = S532和Soundex = S532。]

关于Soundex：

Soundex算法基于英语的特征，例如：

第一个字母具有高度重要性
许多辅音听起来很相似
辅音影响发音而不是元音

一个警告：Soundex是为名字设计的。越短越好。随着名称越来越长，Soundex变得越来越不可靠。

<强>资源：

以下是将{VBA用于Access的示例。
Ken Getz和Mike Gilbert在 VBA开发者手册第2版中对Soundex进行了报道。
有很多关于Soundex和其他变种的信息，例如Soundex2（搜索'Soundex'和'VBA'）。

代码示例：

下面是一些通过快速网络搜索找到的VBA代码，它实现了Soundex算法的变体。

Option Compare Database
Option Explicit

Public Function Soundex(varText As Variant) As Variant
On Error GoTo Err_Handler
    Dim strSource As String
    Dim strOut As String
    Dim strValue As String
    Dim strPriorValue As String
    Dim lngPos As Long

    If Not IsError(varText) Then
        strSource = Trim$(Nz(varText, vbNullString))
        If strSource <> vbNullString Then
            strOut = Left$(strSource, 1&)
            strPriorValue = SoundexValue(strOut)
            lngPos = 2&

            Do
                strValue = SoundexValue(Mid$(strSource, lngPos, 1&))
                If ((strValue <> strPriorValue) And (strValue <> vbNullString)) Or (strValue = "0") Then
                    strOut = strOut & strValue
                    strPriorValue = strValue
                End If
                lngPos = lngPos + 1&
            Loop Until Len(strOut) >= 4&
        End If
    End If

    If strOut <> vbNullString Then
        Soundex = strOut
    Else
        Soundex = Null
    End If

Exit_Handler:
    Exit Function

Err_Handler:
    MsgBox "Error " & Err.Number & ": " & Err.Description, vbExclamation, "Soundex()"
    Resume Exit_Handler
End Function
Private Function SoundexValue(strChar As String) As String
    Select Case strChar
    Case "B", "F", "P", "V"
        SoundexValue = "1"
    Case "C", "G", "J", "K", "Q", "S", "X", "Z"
        SoundexValue = "2"
    Case "D", "T"
        SoundexValue = "3"
    Case "L"
        SoundexValue = "4"
    Case "M", "N"
        SoundexValue = "5"
    Case "R"
        SoundexValue = "6"
    Case vbNullString
        SoundexValue = "0"
    Case Else
        'Return nothing for "A", "E", "H", "I", "O", "U", "W", "Y", non-alpha.
    End Select
End Function

Levenshtein距离

比较字符串的另一种方法是获取Levenshtein distance。以下是VBA中给出的示例，它取自LessThanDot Wiki：

Function LevenshteinDistance(word1, word2)

Dim s As Variant
Dim t As Variant
Dim d As Variant
Dim m, n
Dim i, j, k
Dim a(2), r
Dim cost

   m = Len(word1)
   n = Len(word2)

   ''This is the only way to use
   ''variables to dimension an array
   ReDim s(m)
   ReDim t(n)
   ReDim d(m, n)

   For i = 1 To m
       s(i) = Mid(word1, i, 1)
   Next

   For i = 1 To n
       t(i) = Mid(word2, i, 1)
   Next

   For i = 0 To m
       d(i, 0) = i
   Next

   For j = 0 To n
       d(0, j) = j
   Next


   For i = 1 To m
       For j = 1 To n

           If s(i) = t(j) Then
               cost = 0
           Else
               cost = 1
           End If

           a(0) = d(i - 1, j) + 1             '' deletion
           a(1) = d(i, j - 1) + 1             '' insertion
           a(2) = d(i - 1, j - 1) + cost      '' substitution

           r = a(0)

           For k = 1 To UBound(a)
               If a(k) < r Then r = a(k)
           Next

           d(i, j) = r

       Next

   Next

   LevenshteinDistance = d(m, n)

End Function

Answer 2

以下是VBA中SOUNDEX algorithm的几个工作示例：

Answer 3

除了Soundex，它经常给你太松散的匹配才真正有用，你还应该看看Soundex2（更细粒度的Soundex变体），以及不同类型的匹配，Simil（）。我全部使用这三个。

Answer 4

您正在寻找SOUNDEX。

Answer 5

还要考虑使用名字和姓氏的前两个或三个字母。在一个数据库中，我有10,000个名字Jo Sm（Joe / John / Joan Smith）只返回了三到四个记录。

还有什么类型的名字。你打算让人们使用缩短的版本吗？例如，我的合法名字是安东尼，但我总是叫托尼。

在VBA中查找类似的发声文本

5 个答案: