SoundEx - Suchen nach ähnlich klingenden Namen Schmidt, Schmitt oder Schmid - wie schreibt sich den nun der Name der gesuchten Adresse? Mit SoundEx ist das egal!
Autor:   Dieter Otter	Bewertung:     [ Jetzt bewerten ]	Views:  27.259
https://www.tools4vb.com	System:  Win9x, WinNT, Win2k, Win8, Win10, Win11	Beispielprojekt auf CD

Geben Sie hier Ihre persönliche Bewertung ab! Anzahl Bewertungen bisher: 71 Bewertung insgesamt: gut Durchschnittliche Bewertung: 4.1 von 5 Sternen

sehr gut     gut     nützlich     mittelmäßig     mangelhaft

Kennen Sie das? Sie suchen anhand eines Namens nach einer Adresse in Ihrer Adress-Datenbank. Doch irgendwie finden Sie die Adresse nicht. Gesucht wurde nach dem Namen Schmitt - leider ohne Erfolg! Warum? Vielleicht schreibts sich der Name ja auch Schmidt oder Schmid. Also erneute suchen: Diesmal nach Schmidt - wieder kein Erfolg. Nun gut, es gibt ja auch noch Schmid - Volltreffer!

Leider wurden jetzt aber drei Suchvorgänge benötigt - alles kostbare Zeit, von der man meist nur wenig hat.

Irgendwie wünscht man sich, dass automatisch nach ähnlich klingenden Namen gesucht werden könnte. Dann würden in der Eregbnisliste alle Schmitts, Schmidts und Schmids stehen und man bräuchte nur den gesuchten Eintrag anklicken.

Ein Algorithmus muss her - und zwar einer, der die Namen so umsetzt, dass eben auch ähnlichklingende Namen gefunden werden.

Und hier ist er - der SoundEx-Algorithmus:

Public Function Soundex(ByVal strName As String) As String
  Dim strTemp1 As String
  Dim strTemp2 As String
  Dim I As Integer
 
  strTemp1 = "": strTemp2 = ""
 
  ' Originalwort in Grossbuchstaben umwandeln
  strName = UCase(strName)
 
  ' Erster Buchstabe
  strTemp1 = left$(strName, 1)
 
  ' Jedem weiteren Buchstaben wird nun ein
  ' numerischer Wert zugewiesen
  For I = 2 To Len(strName)
    Select Case Mid$(strName, I, 1)
      Case "B", "F", "P", "V"
        strTemp1 = strTemp1 + "1"
      Case "C", "G", "J", "K", "Q", "S", "X", "Z"
        strTemp1 = strTemp1 + "2"
      Case "D", "T"
        strTemp1 = strTemp1 + "3"
      Case "L"
        strTemp1 = strTemp1 + "4"
      Case "M", "N"
        strTemp1 = strTemp1 + "5"
      Case "R"
        strTemp1 = strTemp1 + "6"
 
      Case "ß"
        strTemp1 = strTemp1 + "22"
 
      ' Alle anderen Buchstaben, Satzzeichen und
      ' Zahlen werden ignoriert
    End Select
  Next
 
  strTemp2 = left$(strName, 1)
 
  ' Jetzt werden alle sich direkt wiederholenden
  ' numerische Werte entfernt
  For I = 2 To Len(strTemp1)
    If Mid$(strTemp1, I - 1, 1) <> Mid$(strTemp1, I, 1) Then
      strTemp2 = strTemp2 + Mid$(strTemp1, I, 1)
    End If
  Next
 
  ' Und hier ist das Ergebnis
  Soundex = strTemp2
End Function

Welche Ergebnisse liefert der SoundEx-Algorithmus nun bei den Namen "Schmitt", "Schmidt" und "Schmid"?

Schmitt	S253
Schmidt	S253
Schmid	S253

Wie Sie sehen, liefern alle drei Namen das gleiche SoundEx-Ergebnis.

Wie verbindet man nun den SoundEx-Algorithmus mit einer Adress-Datenbank?
Hierzu fügen Sie der Datenbank-Tabelle einfach ein neues Feld hinzu und nennen es SoundEx. Beim Speichern neuer und Ändern vorhandener Adressen müssen Sie jetzt zusätzlich den mit der SoundEx-Funktion ermittelten String mit abspeichern:

' Datensatz speichern
With Rs
  .AddNew
  .Fields("Name") = txtName.Text
  ...
  .Fields("SoundEx") = SoundEx(txtName.Text)
  .Update
End With

Und wenn nun nach einem Namen gesucht wird, suchen Sie einfach (zusätzlich) innerhalb des SoundEx-Feldes:

Dim SQL As String
Dim Rs As Recordset
 
SQL = "SELECT * FROM Adressen WHERE Name = '" + strSuch + "'" & _
  " OR SoundEx = '" + SoundEx(strSuch) + "'"
Set Rs = Db.OpenRecordset(SQL)