Cách tìm kiếm từ khóa bằng mã Soundex

Chuyên mục:
Excel VBA

Soundex là thuật toán có tác dụng mã hóa các từ thành các đoạn mã dài 4 ký tự, trong đó chứa 1 chữ cái và 3 ký tự số. Lợi ích của Soundex là khả năng hỗ trợ tìm kiếm từ khóa dựa vào cách chúng được phát âm, thay vì cách đánh vần. Chẳng hạn lấy ví dụ từ “Maris”. Mã Soundex của nó là M620. Các từ gần giống Maris (bao gồm Mares, Marriss, Mariss và Mairis) đều có chung một mã Soundex tương tự như nó.

Quy tắc trong Soundex

Mỗi mã Soundex luôn có đầy đủ 4 ký tự chữ và số (cụ thể là 1 ký tự chữ và 3 ký tự số)
Chữ cái đầu tiên của từ khóa sẽ chính là ký tự đầu tiên trong mã Soundex của từ đó.
3 ký tự số còn lại được xác định từ các chữ cái khác có trong từ khóa, được số hóa theo bảng Số hóa ký tự Soundex dưới đây
Các chữ cái gần nhau và có chung một mã Soundex sẽ được coi là 1 ký tự số duy nhất.
Nếu từ cần mã hóa không đủ độ dài để có thể chuyển đổi thành mã Soundex 4 ký tự thì ta sử dụng số 0 để thay thế các ký tự còn thiếu.

Mã số tương ứng	Chữ cái
1	B F P V
2	C G J K Q S X Z
3	D T
4	L
5	M N
6	R
Không có	A E H I O U Y W

Hàm SOUNDEX

Dưới đây ta sẽ sử dụng một hàm trong VBA có tên SOUNDEX với chức năng mã hóa các ký tự chữ thành mã Soundex. Hàm này được lập trình bởi Richard J.Yanco.

Ta có thể sử dụng hàm này ngay trong thanh công thức của bảng tính, hoặc có thể gọi ra trong quá trình chạy VBA. Bạn có thể xem nội dung câu lệnh ở bên dưới. Lưu ý là trong quá trình chạy hàm SOUNDEX sẽ sử dụng thêm 1 hàm nữa có tên Category.

Function SOUNDEX(Surname As String) As String
' Developed by Richard J. Yanco
' This function follows the Soundex rules given at
' http://home.utah-inter.net/kinsearch/Soundex.html

    Dim Result As String, c As String * 1
    Dim Location As Integer

    Surname = UCase(Surname)

'   First character must be a letter
    If Asc(Left(Surname, 1)) < 65 Or Asc(Left(Surname, 1)) > 90 Then
        SOUNDEX = ""
        Exit Function
    Else
'       St. is converted to Saint
        If Left(Surname, 3) = "ST." Then
            Surname = "SAINT" & Mid(Surname, 4)
        End If

'       Convert to Soundex: letters to their appropriate digit,
'         A,E,I,O,U,Y ("slash letters") to slashes
'         H,W, and everything else to zero-length string

        Result = Left(Surname, 1)
        For Location = 2 To Len(Surname)
            Result = Result & Category(Mid(Surname, Location, 1))
        Next Location
      
'       Remove double letters
        Location = 2
        Do While Location < Len(Result)
            If Mid(Result, Location, 1) = Mid(Result, Location + 1, 1) Then
                Result = Left(Result, Location) & Mid(Result, Location + 2)
            Else
                Location = Location + 1
            End If
        Loop
    
'       If category of 1st letter equals 2nd character, remove 2nd character

        If Category(Left(Result, 1)) = Mid(Result, 2, 1) Then
            Result = Left(Result, 1) & Mid(Result, 3)
        End If
    
'       Remove slashes
        For Location = 2 To Len(Result)
            If Mid(Result, Location, 1) = "/" Then
                Result = Left(Result, Location - 1) & Mid(Result, Location + 1)
            End If
        Next
    
'       Trim or pad with zeroes as necessary
        Select Case Len(Result)
            Case 4
                SOUNDEX = Result
            Case Is < 4
                SOUNDEX = Result & String(4 - Len(Result), "0")
            Case Is > 4
                SOUNDEX = Left(Result, 4)
        End Select
    End If
End Function

Private Function Category(c) As String
'   Returns a Soundex code for a letter
    Select Case True
        Case c Like "[AEIOUY]"
            Category = "/"
        Case c Like "[BPFV]"
            Category = "1"
        Case c Like "[CSKGJQXZ]"
            Category = "2"
        Case c Like "[DT]"
            Category = "3"
        Case c = "L"
            Category = "4"
        Case c Like "[MN]"
            Category = "5"
        Case c = "R"
            Category = "6"
        Case Else 'This includes H and W, spaces, punctuation, etc.
            Category = ""
    End Select
End Function

Trong file demo (có link đính kèm ở đầu bài) có một danh sách hơn 4,000 từ. Bạn có thể thử tìm 1 tên bất kỳ trong danh sách ấy, và sau đó xác định một từ trùng khớp hoặc gần giống với nó nhất.