|
Tipp 0081
|
Doppelte Datensätze löschen
|
 |
|
Autor/Einsender:
Datum: |
|
Angie
19.11.2002 |
|
| Entwicklungsumgebung: |
|
Excel 97 |
|
|
|
Der bisherige Tipp "Doppelte Datensätze löschen" hatte den Nachteil, dass in nur einer
Spalte nach doppelten Datensätzen gesucht wurde. Was nun, wenn man mehrere Spalten als
Suchkriterium benötigt? Mal angenommen, Sie haben eine Datei mit Nachname, Vorname,
Geburtsdatum. Wenn Sie jetzt in der Spalte Nachname nach doppelten Datensätzen suchen,
werden sämtliche Mitglieder einer Familie gelöscht mit Ausnahme eines einzigen. In diesem
neuen Tipp erfahren Sie, wie man die Datensätze löscht bzw. herausfiltert, die
tatsächlich mehrmals vorkommen, d. h. in denen alle Angaben identisch sind.
|
|
|
|
|
Hier werden die Daten zunächst mit der in Excel integrierten AdvancedFilter-Methode
(Spezialfilter) gefiltert, so dass keine Duplikate mehr sichtbar sind. Anschließend werden die
ausgeblendeten Zeilen mit den Duplikaten gelöscht. Im Gegensatz zu Beispiel 2 bleibt hier
die Original-Tabelle nicht erhalten.
|
|
| |
Public Sub DeleteDuplicatesFilter()
Dim wksData As Worksheet
Dim rngData As Range
Dim nColsCnt As Integer
Dim nRowsCnt As Long
Dim nRow As Long
Dim nRowsDel As Long
Application.ScreenUpdating = False
Set wksData = ActiveSheet
With wksData
nColsCnt = .UsedRange.Columns.Count
nRowsCnt = .UsedRange.Rows.Count
Set rngData = _
.Range(.Cells(1, 1), .Cells(nRowsCnt, nColsCnt))
End With
rngData.AdvancedFilter Action:=xlFilterInPlace, Unique:=True
nRowsDel = 0
For nRow = nRowsCnt To 2 Step -1
With wksData
If .Rows(nRow).Hidden = True Then
.Rows(nRow).EntireRow.Delete
nRowsDel = nRowsDel + 1
End If
End With
Next nRow
If wksData.FilterMode = True Then
wksData.ShowAllData
End If
Application.ScreenUpdating = True
MsgBox "Es wurden " & nRowsDel & " doppelte " & _
"Datensätze gelöscht!", vbOKOnly + vbInformation, _
Title:="Doppelte Datensätze löschen"
Set rngData = Nothing
Set wksData = Nothing
End Sub
|
|
|
|
|
|
Soll die Original-Tabelle erhalten bleiben, so können die gefilterten Daten ohne
Duplikate entweder in einem separaten Bereich der Original-Tabelle ausgegeben werden
oder auch, wie in diesem Beispiel, auf einem neuen Tabellenblatt. Hier werden die
Daten mit der in Excel integrierten AdvancedFilter-Methode (Spezialfilter)
gefiltert und ohne Duplikate in einer neuen Tabelle ausgegeben.
|
|
| |
Public Sub FilterDuplicates()
Dim wkbData As Workbook
Dim wksData As Worksheet
Dim wksDataNew As Worksheet
Dim rngData As Range
Dim nColsCnt As Integer
Dim nRowsCnt As Long
Application.ScreenUpdating = False
Set wkbData = ActiveWorkbook
Set wksData = wkbData.ActiveSheet
Set wksDataNew = wkbData.Worksheets.Add
With wksData
nColsCnt = .UsedRange.Columns.Count
nRowsCnt = .UsedRange.Rows.Count
Set rngData = _
.Range(.Cells(1, 1), .Cells(nRowsCnt, nColsCnt))
End With
rngData.AdvancedFilter Action:=xlFilterCopy, _
CopyToRange:=wksDataNew.Range("A1"), Unique:=True
Application.ScreenUpdating = True
MsgBox "Die gefilterten Datensätze wurden auf das " & _
"Tabellenblatt '" & wksDataNew.Name & "' kopiert!", _
vbOKOnly + vbInformation, Title:="Datensätze filtern"
Set rngData = Nothing
Set wksDataNew = Nothing
Set wksData = Nothing
End Sub
|
|
|
|
|
|
Nicht immer ist eine Tabelle so aufgebaut, dass es eine Überschriftzeile gibt. Wenn also keine
Überschriftzeile vorhanden ist, und ggf. auch noch eine oder mehrere leere Zellen in der
1. Zeile des zu filternden Bereichs vorhanden sind, wird man bei der Ausführung der
Beispiele 1 und 2 scheitern.
|
|
Hier also ein Beispiel, wie man Datensätze "zu Fuß" vergleichen kann. Dafür werden zuerst die
Daten in der Tabelle sortiert und dann Zeile für Zeile verglichen. Wenn übereinstimmende
Zeilen gefunden werden, werden diese gelöscht.
|
|
| |
Public Sub DeleteDuplicatesSort()
Dim wksData As Worksheet
Dim rngData As Range
Dim nColsCnt As Integer
Dim nRowsCnt As Long
Dim nRow As Long
Dim nCol As Integer
Dim nRowsDel As Long
Dim blnDuplicate As Boolean
Application.ScreenUpdating = False
Set wksData = ActiveSheet
With wksData
nColsCnt = .UsedRange.Columns.Count
nRowsCnt = .UsedRange.Rows.Count
Set rngData = _
.Range(.Cells(1, 1), .Cells(nRowsCnt, nColsCnt))
rngData.Sort Key1:=.Range("A1"), Order1:=xlAscending, _
Key2:=.Range("B1"), Order2:=xlAscending, _
Key3:=.Range("C1"), Order3:=xlAscending, _
Header:=xlYes, OrderCustom:=1, _
MatchCase:=False, Orientation:=xlTopToBottom
End With
wksData.Range("A1").Select
nRowsDel = 0
For nRow = nRowsCnt To 2 Step -1
blnDuplicate = True
With wksData
For nCol = 1 To nColsCnt
If .Cells(nRow, nCol).Value <> _
.Cells(nRow - 1, nCol).Value Then
blnDuplicate = False
Exit For
End If
Next nCol
If blnDuplicate Then
.Rows(nRow).EntireRow.Delete
nRowsDel = nRowsDel + 1
End If
End With
Next nRow
Application.ScreenUpdating = True
MsgBox "Es wurden " & nRowsDel & " doppelte " & _
"Datensätze gelöscht!", vbOKOnly + vbInformation, _
Title:="Doppelte Datensätze löschen"
Set rngData = Nothing
Set wksData = Nothing
End Sub
|
|
|
|
|
|
Die im Download befindlichen *.bas-Dateien können in Excel im VB-Editor importiert werden.
|
|
| Windows-Version |
| 95 |
 |
|
| 98/SE |
|
|
| ME |
|
|
| NT |
|
|
| 2000 |
|
|
| XP |
|
|
| Vista |
|
|
| Win
7 |
|
|
|
| Excel-Version |
| 95 |
 |
|
| 97 |
|
|
| 2000 |
|
|
| 2002
(XP) |
|
|
| 2003 |
|
|
| 2007 |
|
|
| 2010 |
|
|
|
|
Download (5,1 kB)
|
Downloads bisher: [ 2632 ]
|
|
|
Vorheriger Tipp
Zum Seitenanfang 