Doppelte Einträge löschen

Forumthread: Doppelte Einträge löschen

07.08.2003 11:17:01

Spawn

Hallo,
ich habe eine Liste mit 5000 Zeilen und 10 Spalten.
Die Spalten enthalten Adressen, Orte, eMail, Datum ...
Sind eMail- Adressen mehrfach vorhanden, sollen die Zeilen gelöscht werden, so dass die eMail- Adresse nur noch einmal vorhanden ist. Allerdings nur, wenn auch das Datum überein stimmt. Ist es unterschiedlich, darf die Zeile nicht gelöscht werden.
Hat da jemand eine Lösung für?

3
Beiträge zum Forumthread

Beiträge zu diesem Forumthread

Betreff

Datum

Anwender

AW: Doppelte Einträge löschen

07.08.2003 12:36:03

Lothar
AW: Doppelte Einträge löschen

07.08.2003 12:46:29

Stephan
AW: Doppelte Einträge löschen

07.08.2003 12:53:05

ingo

AW: Doppelte Einträge löschen

07.08.2003 12:36:03

Lothar

Annahme: Es gibt eine Überschriftenspalte, Email in Spalte B, Datum in Spalte A
Dann folgende Schritte:
- Sortiere nach 1. Spalte B, 2. Spalte A jeweils aufsteigend
- Füge in Spalte C ein: =WENN(UND(B3=B2;A3=A2);1;0)
runterkopieren
- markiere Spalte C kopieren und WERTE einfügen
- Sortiere nach Spalte C absteigend.
Nun kannst Du alle Zeilen löschen, die in Spalte C eine 1 haben
ggf. musst Du deinen Spalten entsprechend die Formel anpassen.
Gruss
Lothar

AW: Doppelte Einträge löschen

07.08.2003 12:46:29

Stephan

Hi Spawn!
Bereich markiern - Daten - Filter-Spezialfilter - keine Duplikate
Gruß
Stephan

AW: Doppelte Einträge löschen

07.08.2003 12:53:05

ingo

Hallo Spawn???,
folgendes macro löscht alle zeilen, die in der aktuellen Tabelle in den ersten zehn spalten (ab zeile 2) gleiche einträge haben (bis auf das original)


Sub doppelte_löschen_10()
Dim zelle As Range
Application.ScreenUpdating = False
For Each zelle In ActiveSheet.Range("a2:a" & ActiveSheet.Range("a65536").End(xlUp).Row)
ActiveSheet.Range("iv" & zelle.Row).FormulaLocal = "=a" & zelle.Row & "&b" & zelle.Row & "&c" & zelle.Row & "&d" & zelle.Row & "&e" & zelle.Row & "&f" & zelle.Row & "&g" & zelle.Row & "&h" & zelle.Row & "&i" & zelle.Row & "&j" & zelle.Row
ActiveSheet.Range("iu" & zelle.Row).FormulaLocal = "=zählenwenn(iv2:iv" & ActiveSheet.Range("a65536").End(xlUp).Row & ";iv" & zelle.Row & ")"
Next
For Each zelle In ActiveSheet.Range("a2:a" & ActiveSheet.Range("a65536").End(xlUp).Row)
If ActiveSheet.Range("iu" & zelle.Row) > 1 Then
zelle.EntireRow.Delete
End If
Next
ActiveSheet.Range("iu1:iv1").EntireColumn.Delete
Application.ScreenUpdating = True
End Sub

Ist zwar nicht besonders elegant gelöst, funktioniert aber (hoffentlich auch bei Dir ;-))
Gruß Ingo

Beliebteste Forumthreads (12 Monate)

Forumthread: Doppelte Einträge löschen

3 Beiträge zum Forumthread Beiträge zu diesem Forumthread

Forumthreads zu verwandten Themen

Beliebteste Forumthreads (12 Monate)

3
Beiträge zum Forumthread

Beiträge zu diesem Forumthread