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"?
Wie Sie sehen, liefern alle drei Namen das gleiche SoundEx-Ergebnis. Wie verbindet man nun den SoundEx-Algorithmus mit einer Adress-Datenbank? ' 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 26.294 mal aufgerufen.
Anzeige
![]() ![]() ![]() (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. |
vb@rchiv CD Vol.6 ![]() ![]() Geballtes Wissen aus mehr als 8 Jahren vb@rchiv! Online-Update-Funktion Entwickler-Vollversionen u.v.m. Tipp des Monats ![]() Dieter Otter PopUp-Menü wird nicht angezeigt :-( In diesem Tipp verraten wir Ihnen, wie Sie Probleme mit PopUp-Menüs umgehen können, wenn diese unter bestimmten Umständen einfach nicht angezeigt werden. sevWizard für VB5/6 ![]() Professionelle Assistenten im Handumdrehen Erstellen Sie eigene Assistenten (Wizards) im Look & Feel von Windows 2000/XP - mit allem Komfort und zwar in Windeseile :-) |
||||||||||||||||||||||
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. |