Soundex

Används för att jämföra ord. Inte efter hur de skrivs utan efter HUR DE LÅTER.

Användning:

Namn1 och Namn2 antas innhålla t.ex. personnamn
Soundex(Namn1) = Soundex(Namn2)
ger True om namnen är Smith och Smyte
ger True om namnen är Christer och Krister
ger False om namnen är Karin och Krister
ger True om orden är Banan och Panaani
ger False om orden är Banan och Pataani

Function Soundex (ByVal sText)
   Dim sOrd As String
   Dim sNummer As String
   Dim sSdx As String
   Dim sAktuell As String
   Dim sFörraAs String
   Dim iVarv As Integer
   Dim sTecken As Integer
   Dim iAscii As Integer

   sOrd = UCase(sText)    ' bara stora bokstäver
   sNummer = "01230120022455012623010202"   ' SOUNDEX tabell
               ' se till att ni skriver in den rätt!!!!
   ' Egentligen säger SOUNDEX algoritmen att det skall
   ' vara som nedan
   ' sSdx = Left(sOrd, 1)   ' Starta med första tecknet
   ' For iVarv = 2 To Len(sOrd)   ' Loopa igenom resten av strängen
   ' ...
   ' Men om det första tecknet är tex Å fungerar följande
   ' variant mycket bättre
   sSdx = ""    ' Starta med ingenting
   For iVarv = 1 To Len(sOrd)   ' Loopa igenom strängen
      sTecken = Mid(sOrd, iVarv, 1)   ' tag ett tecken
      ' konvertera ASCII värdet till SOUNDEX tabellenindex
      iAscii = Asc(sTecken) - 64   
      If iAscii >= 1 And iAscii <= 26 Then ' acceptera endast tecken
        ' slå upp det i SOUNDEX tabellen
         sAktuell = Mid(sNummer, iAscii, 1)
         If sAktuell <> sFörra And sAktuell <> "0" Then
            ' om olika och inte specialtecken
            sFörra = sAktuell ' spara förra värdet
            sSdx = sSdx + sAktuell ' bygg upp resultatsträngen
         End If
      End If
   Next Varv
   ' Se till att vi får fyra tecken totalt.
   Soundex = Left(sSdx + "0000", 4)
End Function