Dublikatsuche in der Datenbank

Eines der größten Probleme einer Datenbank sind ungewollte identische Einträge. Wird z.B. ein Kunde versehentlich doppelt geführt, erhält er vom System jeweils eine eigene ID, oder, wenn vorgesehen eine eigene Kundennummer und kann damit als Doppeleintrag nur noch durch Zufall entdeckt werden. Besonders peinlich, wenn "der eine Kunde" eine Liefersperre erhält, der andere aber weiterhin beliefert wird.
Access erlaubt zwar über eine bestimmte Abfrage eine Suche nach Dublikaten, aber sonderlich hilfreich ist diese nicht- erstens muss Sie explizit ausgeführt werden, zweitens stehen die Dubletten bereits in den Stammdaten.

Sinnvoller ist, bei der Eingabe neuer Daten bereits den Stamm nach gleichen oder ähnlichen Eintragungen zu durchforsten. Bei Adressdaten bringt bereits der Vergleich von Postleitzahl und Straße gute Ergebnisse- bei Firmenadressen eher unwahrscheinlich, dass zwei Firmen die gleiche Adresse haben. Zusätzlich muss jedoch auch noch auf den Namen verglichen werden.Das Problem hier sind ähnliche Schreibweisen wie Müller und Mueller, die für die Datenbank absolut unterschiedlich sind. Bei Firmenadressen stören für einen exakten Vergleich vorhandene oder fehlende Zusätze wie "GmbH", "&Co." und ähnliche.
Ein Vergleichsprogramm muss also nach dem Klang vergleichen können und Zusätze der o.g. Art ausblenden.

Das nebenstehende Formular dient der Erfassung von neuen Lieferanten. Da es Lieferanten gibt, die einen Löschvermerk haben und einem normalen User nicht angezeigt werden, besteht die Gefahr, dass diese einfach neu angelegt werden.
Nach Eingabe der Firmendaten durchsucht das Programm die Stammdaten nach gleicher PLZ und gleicher Straße. Dazu wird der Teil "str." oder "straße" oder "strasse" mitsamt der Hausnummer abgetrennt, sodass der Vergleich auf "70193Rosenberg" lautet.

Der Firmennname wird um evtl. zusätzliche Bestandteile wie "Gebrüder", "GmbH", oder andere gemäß einer Liste gekürzt und mit dem Soundex- Verfahren bewertet.Da bei jeder Neueintragung der Soundex- Code mit abgespeichert wird, ist die Suche nach vergleichbaren Codes sehr schnell und effizient.

Die Ergebnisse werden in der unteren Liste dargestellt. Ein Doppelklick auf einen Eintrag öffnet den vorhandenen Eintrag zum Vergleich.

Über den Button "Eintrag" wird der Eintrag dann vorgenommen.

 

 

Die Funktion Soundex besteht aus 3 Teilen:
- der Funktion Soundrein mit der Liste unerwünschter Begriffe
- der Funktion SoundTrenn, um den Namen um die Begriffe zu verkürzen und
- der Funktion Soundex zur Ermittlung des Soundex- Codes.

Option Compare Database

Public Function Soundex(ByVal strName As String) As String
Dim strTemp1 As String
Dim strTemp2 As String
Dim I, j, Pos, strLaenge, FndLaenge As Integer

' Unerwünschte Begriffe zum Ausblenden

strName = soundtrenn(strName)

' Kürzen auf 20 Zeichen
strName = Left(strName, 20)


' 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"
End Select
Next
strTemp2 = Left$(strName, 1)
'Entfernen aller sich direkt wiederholenden Werte
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

'hier das Ergebnis
Soundex = strTemp2

End Function

Public Function soundtrenn(ByVal strName As String) As String
Dim Zerlegen(20), Wort, strNameNeu As String
Dim I, j, k, strLaenge, Pos As Integer

' Original String in Grossbuchstaben umwandeln
strName = UCase(strName)
strLaenge = Len(strName)

' Original String in maximal 20 Worte zerlegen
For I = 1 To 20
Pos = InStr(1, strName, " ")
If Pos > 0 Then
Wort = Left(strName, (Pos - 1))
strNameNeu = strNameNeu & SoundRein(Wort)
strName = Right(strName, strLaenge - Pos)
strLaenge = strLaenge - Pos
Debug.Print I, " ", Wort
End If
If Pos = 0 Then Exit For
Next I
Wort = strName
strNameNeu = strNameNeu + SoundRein(Wort)
j = I
Debug.Print I, " ", Wort
soundtrenn = strNameNeu
End Function

Public Function SoundRein(ByVal Wort As String) As String
' Unerwünschte Begriffe zum Ausblenden
Const n As Integer = 13
Dim Finde(n) As String
Finde(1) = "GMBH"
Finde(2) = "KG"
Finde(3) = "CO"
Finde(4) = "AG"
Finde(5) = "SOHN"
Finde(6) = "SÖHNE"
Finde(7) = "UND"
Finde(8) = "PARTNER"
Finde(10) = "GEBR"
Finde(11) = "GEBRÜDER"
Finde(12) = "DEUTSCHLAND"

' Entfernen der unerwünschten Begriffe
If Len(Wort) < 3 Or Right(Wort, 1) = "." Then
Wort = ""
Exit Function
End If
For j = 1 To n
If Wort = Finde(j) Then Wort = ""
Next
SoundRein = Wort
End Function