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
 
 
 
      |