vb@rchiv
VB Classic
VB.NET
ADO.NET
VBA
C#
vb@rchiv Offline-Reader - exklusiv auf der vb@rchiv CD Vol.4  
 vb@rchiv Quick-Search: Suche startenErweiterte Suche starten   RSS-Feeds  | Newsletter  | Impressum  | Datenschutz  | vb@rchiv CD Vol.6  | Shop Copyright ©2000-2017
 
zurück
Rubrik: Variablen/Strings · Algorithmen/Mathematik   |   VB-Versionen: VB4, VB5, VB620.11.01
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 OtterBewertung:     [ Jetzt bewerten ]Views:  20.728 
www.tools4vb.deSystem:  Win9x, WinNT, Win2k, Win8, Win10 Beispielprojekt auf CD 

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"?

SchmittS253
SchmidtS253
SchmidS253

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)

Dieser Tipp wurde bereits 20.728 mal aufgerufen.

Voriger Tipp   |   Zufälliger Tipp   |   Nächster Tipp

Über diesen Tipp im Forum diskutieren
Haben Sie Fragen oder Anregungen zu diesem Tipp, können Sie gerne mit anderen darüber in unserem Forum diskutieren.

Neue Diskussion eröffnen

nach obenzurück


Anzeige

Kauftipp Unser Dauerbrenner!Diesen und auch alle anderen Tipps & Tricks finden Sie auch auf unserer aktuellen vb@rchiv  Vol.6
(einschl. Beispielprojekt!)

Ein absolutes Muss - Geballtes Wissen aus mehr als 8 Jahren vb@rchiv!
- nahezu alle Tipps & Tricks und Workshops mit Beispielprojekten
- Symbol-Galerie mit mehr als 3.200 Icons im modernen Look
Weitere Infos - 4 Entwickler-Vollversionen (u.a. sevFTP für .NET), Online-Update-Funktion u.v.m.
 
   

Druckansicht Druckansicht Copyright ©2000-2017 vb@rchiv Dieter Otter
Alle Rechte vorbehalten.
Microsoft, Windows und Visual Basic sind entweder eingetragene Marken oder Marken der Microsoft Corporation in den USA und/oder anderen Ländern. Weitere auf dieser Homepage aufgeführten Produkt- und Firmennamen können geschützte Marken ihrer jeweiligen Inhaber sein.

Diese Seiten wurden optimiert für eine Bildschirmauflösung von mind. 1280x1024 Pixel