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.
Beispiel 1
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
 
Beispiel 2
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
 
Beispiel 3
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
 
Hinweis
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: [ 2551 ]

Vorheriger Tipp Zum Seitenanfang Nächster Tipp

Startseite | Projekte | Tutorials | API-Referenz | VB-/VBA-Tipps | Komponenten | Bücherecke | VB/VBA-Forum | VB.Net-Forum | DirectX-Forum | Foren-Archiv | DirectX | VB.Net-Tipps | Chat | Spielplatz | Links | Suchen | Stichwortverzeichnis | Feedback | Impressum

Seite empfehlen Bug-Report
Letzte Aktualisierung: Montag, 25. Juli 2011