Zusammenfassung
Erfahren Sie, wie Sie den Soundex-Algorithmus zum Suchen ähnlich lautender Namen verwenden.
Techniken
VBA
Voraussetzungen
Access 97 und höher
Beispieldateien
Martin Hoffmann, Düsseldorf; André Minhorst, Duisburg
Eine oft benötigte Funktion in einer Datenbank ist das Suchen nach bestimmten Daten. Dies lässt sich mit ein wenig Fleißarbeit leicht realisieren. Interessant wird es, wenn Sie die Suche mit zusätzlichem Komfort ausstatten möchten – etwa, indem Sie der Suchfunktion zusätzlich die Möglichkeit zum Suchen nach ähnlich klingenden Begriffen hinzufügen. Wie man das programmieren soll? Nun, das ist gar nicht schwer. Mit dem so genannten Soundex-Algorithmus erzeugen Sie aus Wörtern einen bestimmten Code, der nicht nur im Englischen, sondern auch im Deutschen verblüffend gute Ergebnisse liefert.
Knackpunkt der nachfolgend vorgestellten Suchfunktion ist der Soundex-Algorithmus, der aus einem Namen einen Code aus einem Buchstaben und drei Zahlen erzeugt. Der Algorithmus arbeitet nach den folgenden Regeln:
|
Buchstabe |
Soundex-Code |
|
B, F, P, V |
1 |
|
C, G, J, K, Q, S, X, Z |
2 |
|
D, T |
3 |
|
L |
4 |
|
M, N |
5 |
|
R |
6 |
Tab. 1: Buchstaben und die entsprechenden Soundex-Codes
Quellcode 1: Diese Funktion liefert den Soundex-Wert für eine Zeichenkette.
Public Function Soundex(sfName As String) As String
On Error GoTo Soundex_err
''''(c) mdb Solution 1998 (Dirk Bauer)
Dim sfSoundex(3) As String
Dim sfZeichen(2) As String, sfZeichenCode(2) As String, _ sfNameNeu As String
Dim iAnzZeichen As Integer, i As Integer
Dim iPos As Integer, iZähler As Integer
''''Zeichenkette in Großbuchstaben umwandeln
''''und Blanks entfernen
sfName = Trim(UCase(sfName))
''''Umlaute und Sonderzeichen ersetzen
iPos = 1
sfNameNeu = ""
For i = 1 To Len(sfName)
sfZeichen(0) = Mid(sfName, iPos, 1)
Select Case Asc(sfZeichen(0))
Case 192, 193, 194, 195, 196, 197, 198: ''''ä, Á...
sfNameNeu = sfNameNeu & "AE"
Case 210, 211, 212, 213, 214, 216: ''''ö...
sfNameNeu = sfNameNeu & "OE"
Case 217, 218, 219, 220: ''''ü...
sfNameNeu = sfNameNeu & "UE"
Case 223: ''''ß
sfNameNeu = sfNameNeu & "SS"
Case Is < 65: ''''Sonderzeichen
sfNameNeu = sfNameNeu
Case Else: ''''Zeichen ohne änderung übernehmen
sfNameNeu = sfNameNeu & sfZeichen(0)
End Select
iPos = iPos + 1
Next i
sfName = sfNameNeu
''''Doppelte Zeichen entfernen
iPos = 1
sfNameNeu = ""
For i = 1 To Len(sfName)
sfZeichen(1) = Mid(sfName, iPos, 1)
sfZeichen(2) = Mid(sfName, iPos + 1, 1)
If sfZeichen(1) <> sfZeichen(2) Then
'''' Zeichen 2 ist NICHT doppelt, also schreiben...
sfNameNeu = sfNameNeu & sfZeichen(1)
End If
iPos = iPos + 1
Next i
sfName = sfNameNeu
''''Benachbarte Zeichen auf identischen Zifferncode prüfen
iPos = 1
sfNameNeu = ""
For i = 1 To Len(sfName)
sfZeichen(1) = Mid(sfName, iPos, 1)
sfZeichen(2) = Mid(sfName, iPos + 1, 1)
''''Code-Ziffer der beiden Zeichen ermitteln
sfZeichenCode(1) = Soundex_CodeZiffer(sfZeichen(1))
If sfZeichenCode(1) <> "KeinCode" And i <> Len(sfName)
''''1. Zeichen hat einen Code, also 2. Zeichen prüfen
sfZeichenCode(2) = Soundex_CodeZiffer(sfZeichen(2))
Beispiel: Bei der Suche nach dem Nachnamen „Meier“ gibt Access in der Regel nur die Personen aus, bei denen die Schreibweise des Namens exakt identisch ist. Mit der Soundex-Suche werden auch Namen wie Mayer, Maier oder Meyer zurückgeliefert, da diese den gleichen Code haben.
Der Code für alle Varianten lautet M600 – M ist der erste Buchstabe, a, y, i und e fallen aus der Wertung, also bleibt nur noch das r, das dem Zahlenwert 6 entspricht. Da keine weiteren Buchstaben vorhanden sind, wird der Code mit zwei Nullen aufgefüllt.
Kein Preis ohne Fleiß …
Natürlich ist dafür auch ein wesentlich höherer Aufwand erforderlich. Die Inhalte der zu durchsuchenden Felder sollten im Vorfeld codiert und in Form des Soundex-Codes in zusätzlichen Feldern gespeichert werden. Man könnte dies auch zur Laufzeit erledigen, aber das würde der Performance sicher nicht gut tun.
Um nach einem Begriff zu suchen, codiert man diesen ebenfalls und vergleicht das Ergebnis mit dem Inhalt des speziell vorbereiteten Feldes. Wie das genau funktioniert, können Sie den folgenden Kapiteln entnehmen.
Als Beispiel für die Suche mit und ohne Soundex dient eine einfache Adressverwaltung.
Quellcode 1: Diese Funktion liefert den Soundex-Wert für eine Zeichenkette (Fortsetzung)
If sfZeichenCode(1) <> sfZeichenCode(2) Then
''''Zeichen 2 wird NICHT mit der gleichen Codeziffer
''''bewertet , also schreiben...
sfNameNeu = sfNameNeu & sfZeichen(1)
iPos = iPos + 1
Else
''''Zeichen 2 wird mit der gleichen Codeziffer be-
''''wertet, also schreiben und Zeichen 2 überspringen...
sfNameNeu = sfNameNeu & sfZeichen(1)
iPos = iPos + 2
i = i + 1
End If
Else
''''1. Zeichen hat keinen Code, also schreiben...
sfNameNeu = sfNameNeu & sfZeichen(1)
iPos = iPos + 1
End If
Next i
''''Nun den Soundex-Code zuordnen
''''1. Zeichen des Soundex setzen und vom restlichen String
''''abschneiden
sfSoundex(0) = Left(sfNameNeu, 1)
sfNameNeu = Right(sfNameNeu, (Len(sfNameNeu) - 1))
iPos = 1
iZähler = 1
For i = 1 To Len(sfNameNeu)
''''Code-Ziffer des Zeichen ermitteln
sfZeichenCode(0) = _ Soundex_CodeZiffer(Mid(sfNameNeu, iPos, 1))
If sfZeichenCode(0) <> "KeinCode" Then
'''' Zeichen bekommt Code-Ziffer, also schreiben
sfSoundex(iZähler) = sfZeichenCode(0)
iZähler = iZähler + 1
End If
If iZähler = 4 Then
GoTo Soundex_exit '''' der Code hat maximal 4 Stellen
Else
iPos = iPos + 1
End If
Next i
Soundex_exit:
''''Prüfen, ob der Code wirklich 4 Stellen hat,
''''sonst am Ende mit Nullen füllen
sfZeichen(0) = sfSoundex(0) & sfSoundex(1) & sfSoundex(2) _ & sfSoundex(3)
Select Case Len(sfZeichen(0))
Case 1: sfZeichen(0) = sfZeichen(0) & "000"
Case 2: sfZeichen(0) = sfZeichen(0) & "00"
Case 3: sfZeichen(0) = sfZeichen(0) & "0"
End Select
Soundex = sfZeichen(0)
Exit Function
Soundex_err:
MsgBox "Fehler beim konvertieren in den Soundex-Code"
Resume Next
End Function
Legen Sie zunächst eine neue Tabelle mit dem Namen tblAdressen an. Fügen Sie die in Abb. 1 dargestellten Datenfelder ein.
Neben den Standardadressfeldern enthält die Tabelle die Felder SoundexFirma und SoundexNachname. Diese nehmen die Soundex-Codes der entsprechenden Adressfelder auf.
Die Codes werden im Formular frmAdressen, dessen Aufbau der folgende Abschnitt erklärt, automatisch aktualisiert.
Im nächsten Schritt legen Sie auf Basis der Tabelle tblAdressen ein Formular zur Eingabe der Adressen an. Abb. 2 zeigt das Formular der Beispieldatenbank.
Da die Inhalte der Felder SoundexFirma und SoundexNachname automatisch berechnet werden, ist für diese Felder keine Eingabe möglich.
Stellen Sie deshalb die Eigenschaft Aktiviert dieser Felder auf Nein und die Eigenschaft Geperrt auf Ja.
Zur Berechnung des Soundex-Codes enthält die Beispieldatenbank im Modul modSoundex die Funktion Soundex. Sie finden die Funktion in Quellcode 1.
Quellcode 2: Aufruf der Funktion Soundex beim Aktualisieren der Firma …
Private Sub Firma_AfterUpdate()
If Not IsNull(Me!Firma) Then
Me!SoundexFirma = Soundex(Me!Firma)
End If
End Sub
Quellcode 3: … und beim Aktualisieren des Nachnamens.
Private Sub Nachname_AfterUpdate()
If Not IsNull(Me!Nachname) Then
Me!SoundexNachname = Soundex(Me!Nachname)
End If
End Sub
Quellcode 4: Aktualisieren des Adress-Detailformulars nach der Auswahl einer Adresse im Suchen-Formular
Private Sub btnSuchen_Click()
Dim recAdressen As Recordset
RunCommand acCmdSaveRecord
DoCmd.OpenForm "frmAdresseSuchen", WindowMode:=acDialog
If SysCmd(acSysCmdGetObjectState, acForm, "frmAdresseSuchen") = acObjStateOpen Then
With Forms!frmAdresseSuchen
Set recAdressen = Me.RecordsetClone
recAdressen.FindFirst "AdresseNr = " & !lstAdresseNr
Me.Bookmark = recAdressen.Bookmark
DoCmd.Close acForm, .Name
End With
End If
End Sub
Ende des frei verfügbaren Teil. Wenn Du mehr lesen möchtest, hole Dir ...
den kompletten Artikel im PDF-Format mit Beispieldatenbank
diesen und alle anderen Artikel mit dem Jahresabo