betrifft MS Access

Problembeschreibung:

Sie wollen eine statistische Auswertung über die Datensätze in einer Tabelle machen. Leider kommen aber in der auszuwertenden Spalte verschiedene Vorkommen an Werten vor, die für die Auswertung aber das gleiche bedeuten sollen. Eine Vorkommen-Abfrage bringt hier also nicht das gewünschte Ergebnis. Sie könnten jetzt zwar durch Suchen und Ersetzen in Handarbeit die Sache bereinigen, aber spätestens beim nächsten Datenupdate sind diese Änderungen verloren und Sie müssen die Arbeit wiederholen.

Lösungsidee

Die Standardisierung verschiedenen Vorkommen der Werte in der zu analysierenden Spalte wird automatisch realisiert. Zusätzlich werden die verschiedenen Vorkommen in einer Art Übersetzungstabelle gespeichert, so dass beim nächsten Durchlauf bereits gelernte Übersetzungen automatisch ohne Benutzereingriff vorgenommen werden können.

Der nachfolgende Code beschreibt die allgemeine Arbeitsweise dieser Automatisierung. Zu diesem Code gehört noch ein Formular für Benutzerentscheidungen, welches aber hier nicht abgebildet ist. Die komplette Lösung können Sie aber hier herunterladen. In dieser Access-2000 Datenbank sind alle erforderlichen Prozeduren und Funktionen vorhanden und sie ist sofort einsetzbar.

Beispieldatenbank herunterladen

Programmcode

'globale Variable für Rückgabe aus Benutzerformular
Public global_Standardwert As String

Sub Standardisiere_Kriterium(ByVal Quelltabelle As String, ByVal Quellspalte As String, ByVal neu_erstellen As Boolean)
  'standardisiert Werte in einer Spalte zur Vorbereitung als Key-Spalte (Kriterium)
  'benutzt globale Variablen für Rückgabewerte aus Benutzerformular
  'global_Standardwert as String

  Dim db As Database
  Dim SQL As DAO.Recordset
  Dim rs_Tab As Recordset
  Dim rs_Krt As Recordset
  Dim rs_Auto As Recordset
  Dim Tabelle As TableDef
  Dim Feld As Field
  Dim idx As Index
  Dim Kriteriumtabelle As String, Autotabelle As String
  Dim Wert As String
  Dim ID As Long
  Dim Feld_vorhanden As Boolean

  'Datenbankobjekt ermitteln
  Set db = CurrentDb

  'Tabellennamen festlegen
  'Kriteriumtabelle (Key-Table)
  Kriteriumtabelle = "Kriterium_" & Quellspalte
  'Übersetzungstabelle zur Standardisierung
  Autotabelle = "auto_" & Quelltabelle & "_" & Quellspalte

  'existieren diese Tabellen schon?
  If Not Existiert_Tabelle(Kriteriumtabelle) Or Not Existiert_Tabelle(Autotabelle) Then neu_erstellen = True

  'Wenn Kriterium neu erstellt werden soll, dann Kriteriumtabelle & Autotabelle löschen
  If neu_erstellen Then
    If Existiert_Tabelle(Kriteriumtabelle) Then db.TableDefs.Delete Kriteriumtabelle
    If Existiert_Tabelle(Autotabelle) Then db.TableDefs.Delete Autotabelle
    db.TableDefs.Refresh

    'neue Kriteriumtabelle anlegen
    Set Tabelle = db.CreateTableDef
    Tabelle.Name = Kriteriumtabelle
    'Felder der Tabelle definieren
    Set Feld = Tabelle.CreateField("ID", dbLong)
    Tabelle.Fields.Append Feld
    Set Feld = Tabelle.CreateField("Name", dbText, 250)
    Tabelle.Fields.Append Feld
    'Tabelle einsatzbereit machen
    db.TableDefs.Append Tabelle
    'Primärschlüssel auf Feld "ID" einstellen
    Set idx = Tabelle.CreateIndex("PrimaryKey")
    idx.Fields.Append idx.CreateField("ID")
    idx.Primary = True
    Tabelle.Indexes.Append idx
    Set rs_Krt = Tabelle.OpenRecordset
    rs_Krt.Index = "PrimaryKey"

    'Autotabelle anlegen
    Set Tabelle = db.CreateTableDef
    Tabelle.Name = Autotabelle
    'Felder der Tabelle definieren
    Set Feld = Tabelle.CreateField("Name_original", dbText, 250)
    Tabelle.Fields.Append Feld
    Set Feld = Tabelle.CreateField("Name", dbText, 250)
    Tabelle.Fields.Append Feld
    'Tabelle einsatzbereit machen
    db.TableDefs.Append Tabelle
    'Primärschlüssel auf Feld "Name_orginal" einstellen
    Set idx = Tabelle.CreateIndex("PrimaryKey")
    idx.Fields.Append idx.CreateField("Name_original")
    idx.Primary = True
    Tabelle.Indexes.Append idx
    Set rs_Auto = Tabelle.OpenRecordset
    rs_Auto.Index = "PrimaryKey"
  Else
    'Tabellen öffnen
    Set rs_Krt = db.OpenRecordset(Kriteriumtabelle, dbOpenTable)
    rs_Krt.Index = "PrimaryKey"
    Set rs_Auto = db.OpenRecordset(Autotabelle, dbOpenTable)
    rs_Auto.Index = "PrimaryKey"
  End If

  'Quelltabelle um Kriterium-Spalte (Key-Feld) erweitern, falls diese noch nicht existiert
  Feld_vorhanden = False
  For Each Feld In db.TableDefs(Quelltabelle).Fields
    If StrComp(Feld.Name, Kriteriumtabelle, vbTextCompare) = 0 Then
      'Key-Feld schon vorhanden
      Feld_vorhanden = True
      Exit For
    End If
  Next Feld
  'falls Key-Feld noch nicht vorhanden, dann an Tabelle anhängen
  If Not Feld_vorhanden Then
    Set Feld = Tabelle.CreateField(Kriteriumtabelle, dbLong)
    db.TableDefs(Quelltabelle).Fields.Append Feld
    db.TableDefs.Refresh
  End If

  'Jetzt Standardisierung beginnen
  Set rs_Tab = db.OpenRecordset(Quelltabelle, dbOpenTable)
  While Not rs_Tab.EOF
    'Jeden Wert in Quellspalte standardisieren
    'Spaltenwert auslesen
    Wert = "" & rs_Tab.Fields(Quellspalte)
    If Len(Trim(Wert)) = 0 Then Wert = "NULL_NULL"  'Das ist die Hilfsgröße für NULL, da NULL kein Schlüssel sein darf

    'existiert eine schon eine Standardisierung / Übersetzung?
    rs_Auto.Seek "=", Wert
    If rs_Auto.NoMatch Then
      'Nein existiert nicht
      'Lern-Formular starten -> das Formular gibt den vom Benutzer standardisierten Wert in global_Standardwert zurück
      global_Standardwert = 0
      DoCmd.OpenForm "Kriterienkonvertierung_Lernen_Kriterium", , , , , acDialog, Wert & "~" & Kriteriumtabelle & "~" & Autotabelle
      'Benutzerauswahl auswerten
      If Len(global_Standardwert) = 0 Then
        'Benutzer hat Abbruch-Button betätigt
        GoTo Ende
      Else
        'standardisierten Wert übernehmen
        rs_Auto.AddNew
        rs_Auto.Fields("Name_original") = Wert
        rs_Auto.Fields("Name") = global_Standardwert
        rs_Auto.Update
        Wert = global_Standardwert
      End If
    Else
      'Standardisierung existiert -> Wert übernehmen
      Wert = rs_Auto.Fields("Name")
    End If

    'existiert das Kriterium auch?
    Set SQL = db.OpenRecordset("SELECT ID FROM `" & Kriteriumtabelle & "` WHERE Name=''" & Wert & "''")
    If SQL.RecordCount = 0 Then
      'Neues Kriterium in Kriteriumtabelle aufnehmen
      SQL.Close
      'nächst höhere ID herausfinden
      ID = 1
      Set SQL = db.OpenRecordset("SELECT MAX(ID) FROM `" & Kriteriumtabelle & "`")
      If SQL.RecordCount > 0 Then ID = Val("0" & SQL.Fields(0)) + 1
      'neues Kriterium anlegen
      rs_Krt.AddNew
      rs_Krt.Fields("ID") = ID
      rs_Krt.Fields("Name") = Wert
      rs_Krt.Update
    Else
      'ID auslesen und in Key-Feld eintragen
      ID = SQL.Fields("ID")
    End If
    SQL.Close

    'Key-Wert in Key-Feld übernehmen
    rs_Tab.Edit
    rs_Tab.Fields(Kriteriumtabelle) = ID
    rs_Tab.Update

    'nächster Datensatz in Quelltabelle
    rs_Tab.MoveNext
  Wend

Ende:
  'Tabellen schließen
  rs_Auto.Close
  rs_Krt.Close
  rs_Tab.Close
  Set db = Nothing

  'Kontrollausgabe
  MsgBox "Fertig.", vbOKOnly + vbInformation
End Sub

Sub Main_Start()
  Standardisiere_Kriterium "Testtabelle", "zu_standardisieren", True
End Sub