 |
Soundex Key
Posted on 05/31/02 10:18 AM
Posted by Candace Tripp - UA Admin & Utter Angel
Posts: 3035 - Loc: Virginia, USA
Forum: Access Code Archive
|
• Edit
• Reply
• Quote
• Quick Reply
• Print this post
• Bookmark Post
• Notify Moderator
• Top of page
|
Description
Returns a Soundex key for the supplied string
Comments
Returns a Soundex key for the supplied string.
The SOUNDEX algorithm generates a four-character key that describes the phonetic makeup of a word. The first character of this code is the first letter of the word. The remaining three characters are single digits that denote the phonetic value of the first three syllables of the word.
For example, a Soundex key of "A345" means:
"A" is the first letter of the word.
"3" is the phonetic value of the first syllable.
"4" is the phonetic value of the second syllable.
"5" is the phonetic value of the third syllable.
Returns
keyed string
Example
Sub Soundex ()
' ==============================================
' Example code for SoundexCode()
' ----------------------------------------------
' Displays the Soundex keys for a phrase and
' checks to see if they match.
' ==============================================
Dim strKey As String
Dim strKey2 As String
' Return the Soundex key for "Microsoft Access"
strKey = SoundexCode("Microsoft Access")
Debug.Print "The key for 'Microsoft Access' is: " & strKey
' Return the Soundex key for "Mykrosoft Axes"
strKey2 = SoundexCode("Mykrosoft Axes")
Debug.Print "The key for 'Mykrosoft Axes' is: " & strKey2
If strKey = strKey2 Then
Debug.Print "They Match!"
End If
End Sub
Function SoundexCode(strIn As String) As String
' Comments : returns a Soundex key for the supplied string
' Parameters: strIn - string to key
' Returns : keyed string
'
Dim intLen As Integer
Dim intChrCount As Integer
Dim intSDXCount As Integer
Dim intSep As Integer
Dim intSDXCode As Integer
Dim intPrvCode As Integer
Dim chrTmp As String * 1
Dim strSDX As String
Dim strTemp As String
intLen = Len(strIn)
Do Until (intSDXCount = 4 Or intChrCount = intLen)
intChrCount = intChrCount + 1
chrTmp = Mid(strIn, intChrCount, 1)
Select Case chrTmp
Case "B", "F", "P", "V": intSDXCode = 1
Case "C", "G", "J", "K", "Q", "S", "X", "Z": intSDXCode = 2
Case "D", "T": intSDXCode = 3
Case "L": intSDXCode = 4
Case "M", "N": intSDXCode = 5
Case "R": intSDXCode = 6
Case "A", "E", "I", "O", "U", "Y": intSDXCode = -1
Case Else: intSDXCode = -2
End Select
If intChrCount = 1 Then
' Handle the first character
strSDX = UCase(chrTmp)
intSDXCount = intSDXCount + 1
intPrvCode = intSDXCode
intSep = 0
Else
' Handle all other characters
If intSDXCode > 0 And (intSDXCode <> intPrvCode Or intSep = 1) Then
strSDX = strSDX + Format(intSDXCode, "#")
intSDXCount = intSDXCount + 1
intPrvCode = intSDXCode
intSep = 0
ElseIf intSDXCode = -1 Then
intSep = 1
End If
End If
Loop
If intSDXCount < 4 Then
strTemp = String((4 - intSDXCount), "0")
strSDX = strSDX & strTemp
End If
SoundexCode = strSDX
End Function
--------------------
Candace Tripp
http://www.utterangel.com/
|
 |
| Page Jump |
|
Pages: 1
|
|
|
|
| Navigate |
|
|
|
| Page Jump |
|
Pages: 1
|
|
