16

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

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

4

5 回答 5

20

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

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

关于 Soundex：

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

  1. 第一个字母意义重大
  2. 许多辅音听起来很相似
  3. 辅音比元音更能影响发音

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

资源：

  1. 这是一个使用 VBA 进行Access的示例。
  2. Ken Getz 和 Mike Gilbert在VBA Developer's Handbook, 2nd Edition中有一篇关于 Soundex 的文章。
  3. 有很多关于 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 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
于 2009-10-22T14:39:09.180 回答
4

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

于 2009-10-22T14:42:42.307 回答
3

除了 Soundex，它经常给你一个太松散的匹配而没有真正有用，你还应该看看 Soundex2（Soundex 的一个更细粒度的变体），以及另一种匹配，Simil()。我三个都用。

于 2009-10-23T01:23:08.917 回答
0

您正在寻找 SOUNDEX。

于 2009-10-22T14:39:01.000 回答
0

还可以考虑使用名字和姓氏的前两个或三个字母。在一个包含 10,000 个名字的数据库中，Jo Sm (Joe/John/Joan Smith) 只返回了三到四条记录。

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

于 2009-10-22T23:05:23.173 回答