![]() |
|
Tipp 0357
|
Doppelte Datensätze löschen (DAO)
|
 |
|
Autor/Einsender:
Datum: |
|
Angie
25.04.2005 (Update) |
|
| Entwicklungsumgebung: |
|
Excel 2000 |
|
|
|
Mit Hilfe des optionalen Parameters DISTINCT kann die Ausgabe von mehrfach vorhandenen
identischen Datensätzen unterdrückt werden. Die folgende (einfache) SQL-Anweisung gibt alle
Datensätze zurück, aus der alle doppelten Datensätze herausgefiltert wurden.
|
|
| |
SELECT DISTINCT * FROM [Tabelle1$];
|
|
|
|
Sollen nur bestimmte Felder in einer neuen Tabelle ausgegeben und auf Duplikate hin
überprüft werden, so könnte die SQL-Anweisung wie folgt aussehen.
|
|
| |
SELECT DISTINCT Feld1, Feld2, Feld3 FROM [Tabelle1$];
|
|
|
|
Etwas umfangreicher wird die SQL-Anweisung, wenn man z. B. eine Kopie der Quelltabelle,
jedoch ohne Duplikate, erstellen möchte, wenn die Quelltabelle auch Felder enthält, in denen
keine Duplikate erlaubt sind (wie z. B. 'ID', 'Code' oder 'Nr').
|
|
Das folgende Beispiel entfernt alle Datensätze, in denen die enthaltenen Daten der Felder
'Name', 'Vorname' und 'Ort' identisch sind, und gibt, sollten identische Datensätze mehrfach
vorkommen, den Datensatz mit dem kleinsten Wert im Feld 'ID' zurück. Das Ergebnis der Abfrage,
eine Kopie der Quelltabelle, jedoch ohne Duplikate, wird als Abfragetabelle (QueryTable)
in einem neuen Tabellenblatt ausgegeben. Eine mit DAO oder ADO erstellte Abfragetabelle
kann nicht aktualisiert werden.
|
|
| |
Option Explicit
Public Sub DeleteDuplicateRecordsDAO()
Const cMsgTitle As String = _
"VB-fun-Demo - Doppelte Datensätze löschen (DAO)"
Const cWksNameNew As String = "tblKunden_Neu"
Dim objWkb As Workbook
Dim objWksNew As Worksheet
Dim dbs As DAO.Database
Dim rst As DAO.Recordset
Dim strDBName As String
Dim strSQL As String
Dim objQryTable As QueryTable
On Error GoTo err_DeleteRecords
Set objWkb = ThisWorkbook
strDBName = "c:\temp\DAOCopy" & _
Format$(Now, "yyyymmddhhmmss") & ".xls"
objWkb.SaveCopyAs strDBName
Set dbs = DBEngine.OpenDatabase(strDBName, False, True, _
"Excel 8.0;")
strSQL = "SELECT [tblKunden$].* "
strSQL = strSQL & "FROM [tblKunden$] "
strSQL = strSQL & "WHERE "
strSQL = strSQL & "EXISTS "
strSQL = strSQL & "("
strSQL = strSQL & "SELECT NULL "
strSQL = strSQL & "FROM [tblKunden$] AS Tmp "
strSQL = strSQL & "WHERE "
strSQL = strSQL & "Tmp.[Name] = [tblKunden$].[Name] "
strSQL = strSQL & "AND Tmp.[Vorname] = [tblKunden$].[Vorname] "
strSQL = strSQL & "AND Tmp.[Ort] = [tblKunden$].[Ort] "
strSQL = strSQL & "GROUP BY "
strSQL = strSQL & "Tmp.[Name], Tmp.[Vorname], Tmp.[Ort] "
strSQL = strSQL & "HAVING "
strSQL = strSQL & "[tblKunden$].[ID] = MIN(Tmp.[ID])"
strSQL = strSQL & ") "
strSQL = strSQL & "ORDER BY [tblKunden$].[ID]"
strSQL = strSQL & ";"
Set rst = dbs.OpenRecordset(strSQL)
Application.ScreenUpdating = False
On Error Resume Next
Application.DisplayAlerts = False
objWkb.Worksheets(cWksNameNew).Delete
Application.DisplayAlerts = True
Set objWksNew = objWkb.Worksheets.Add( _
After:=objWkb.Sheets(objWkb.Sheets.Count))
objWksNew.Name = cWksNameNew
Set objQryTable = objWksNew.QueryTables.Add( _
rst, objWksNew.Range("A1"))
objQryTable.Refresh
Set objQryTable = Nothing
exit_Sub:
On Error Resume Next
Set objWksNew = Nothing
Set objWkb = Nothing
rst.Close
Set rst = Nothing
dbs.Close
Set dbs = Nothing
Kill strDBName
Application.ScreenUpdating = True
On Error GoTo 0
Exit Sub
err_DeleteRecords:
MsgBox "Fehler " & Err.Number & vbCrLf & Err.Description, _
vbOKOnly + vbCritical, cMsgTitle
Resume exit_Sub
End Sub
|
|
|
|
Der Inhalt des DAO-Recordset-Objekts kann auch mit der CopyFromRecordset-Methode
in das Tabellenblatt eingefügt werden. Um das selbe Ergebnis wie in obigem Beispiel zu erhalten,
ist hier jedoch etwas mehr Code notwendig.
|
|
| |
Dim nFieldsCnt As Integer
Dim astrTmp() As String
Dim i As Integer
nFieldsCnt = rst.Fields.Count
ReDim astrTmp(nFieldsCnt)
For i = 0 To nFieldsCnt - 1
astrTmp(i) = rst.Fields(i).Name
Next
With objWksNew.Cells(1, 1).Resize(1, nFieldsCnt)
.Value = astrTmp
.Font.Bold = True
End With
objWksNew.Cells(2, 1).CopyFromRecordset rst
objWksNew.UsedRange.Columns.AutoFit
|
|
|
|
|
|
Um diesen Tipp ausführen zu können, muss für Excel 97 die
Microsoft DAO 3.51 Object Library oder die
Microsoft DAO 3.6 Object Library für die Excel-Versionen ab
Excel 2000 in das Projekt eingebunden werden.
|
|
| Windows-Version |
| 95 |
 |
|
| 98/SE |
|
|
| ME |
|
|
| NT |
|
|
| 2000 |
|
|
| XP |
|
|
| Vista |
|
|
| Win
7 |
|
|
|
| Excel-Version |
| 95 |
 |
|
| 97 |
|
|
| 2000 |
|
|
| 2002
(XP) |
|
|
| 2003 |
|
|
| 2007 |
|
|
| 2010 |
|
|
|
|
Download (24,8
kB)
|
Downloads bisher: [ 1121 ]
|
|
|
Vorheriger Tipp
Zum Seitenanfang 