Announcement

Collapse
No announcement yet.

Kombinationssuche in Access (97,2000,2002,2003,2007 verfügbar) mit VBA und SQL

Collapse
X
  • Filter
  • Time
  • Show
Clear All
new posts

  • Kombinationssuche in Access (97,2000,2002,2003,2007 verfügbar) mit VBA und SQL

    Hallo,

    hab ein Problem:
    1 DB mit ca. 23. Mio Datensätzen und 4 Spalten.
    Die ersten 3 Spalten (3 Zeichen lang) sind für die Kombinationen und die 4. Spalte (1 Zeichen lang) ist zur Kennzeichnung, ob es eine doppelte Geschichte ist.

    Folgende Datensätze sind enthalten(Beispiel):

    Spalte 1 Spalte 2 Spalte 3 Spalte 4
    A01 A02 A03
    A01 A03 A02
    A02 A01 A03
    A02 A03 A01
    A03 A01 A02
    A03 A02 A01

    Von diesen 6 Datensätzen soll nur einer kein "X" in der 4. Spalte erhalten, weil die anderen "Duppletten" sind und später gelöscht werden sollen.

    Habe auch bisher schon ein Script, welches aber leider eine total schlechte Performance hat.
    Vielleicht hat Einer eine Idee, wie ich die ganze Geschichte beschleunigen kann.

    Code:
    Option Compare Database
    Option Explicit
    Public arrICD(1 To 23000000, 1 To 4) As String


    Public Function Doppelte_Sätze()
    Dim Anzahl, i, j, k, l,y As Long
    Dim KZ As String
    Dim db As Database
    Dim Tabelle As Recordset
    Set db = CurrentDb
    Dim SQL As String

    Set Tabelle = db.OpenRecordset("Tabelle1")
    KZ = "X"
    Anzahl = DLookup("count([D1])", "[Tabelle1]")
    For i = 1 To Anzahl
    arrICD(i, 1) = ""
    arrICD(i, 2) = ""
    arrICD(i, 3) = ""
    arrICD(i, 4) = ""
    Next
    i = 1
    While Not Tabelle.EOF
    arrICD(i, 1) = Tabelle.Fields(0)
    arrICD(i, 2) = Tabelle.Fields(1)
    arrICD(i, 3) = Tabelle.Fields(2)
    i = i + 1
    Tabelle.MoveNext
    Wend

    Tabelle.MoveFirst
    i = 1
    While Not Tabelle.EOF
    If IsNull(Tabelle.Fields(3)) Then
    For i = 1 To Anzahl
    k = 0
    l = 0
    y = 0
    If Tabelle.Fields(0) = arrICD(i, 1) And Tabelle.Fields(1) = arrICD(i, 2) And Tabelle.Fields(2) = arrICD(i, 3) Then
    l = 1
    End If
    If Tabelle.Fields(0) = arrICD(i, 1) Or Tabelle.Fields(0) = arrICD(i, 2) Or Tabelle.Fields(0) = arrICD(i, 3) Then
    k = k + 1
    End If
    If Tabelle.Fields(1) = arrICD(i, 1) Or Tabelle.Fields(1) = arrICD(i, 2) Or Tabelle.Fields(1) = arrICD(i, 3) Then
    k = k + 1
    End If
    If Tabelle.Fields(2) = arrICD(i, 1) Or Tabelle.Fields(2) = arrICD(i, 2) Or Tabelle.Fields(2) = arrICD(i, 3) Then
    k = k + 1
    End If
    If k = 3 And l = 0 Then
    arrICD(i, 4) = "X"
    y = 1
    SQL = "UPDATE Tabelle1 SET Tabelle1.[KZ zum löschen] = '" & KZ & "' WHERE (((Tabelle1.D1)='" & arrICD(i, 1) & "' and (Tabelle1.D2)='" & arrICD(i, 2) & "' and (Tabelle1.D3)='" & arrICD(i, 3) & "' ));"
    DoCmd.RunSQL SQL
    End If
    If y = 1 then Exit For
    Next
    End If
    Tabelle.MoveNext
    Wend

    End Function

  • Christian Marquardt
    replied
    http://entwickler-forum.de/showthread.php?t=60724

    Leave a comment:

Working...
X