Live-Forum - Die aktuellen Beiträge
Datum
Titel
28.03.2024 21:12:36
28.03.2024 18:31:49
Anzeige
Archiv - Navigation
1080to1084
Aktuelles Verzeichnis
Verzeichnis Index
Übersicht Verzeichnisse
Vorheriger Thread
Rückwärts Blättern
Nächster Thread
Vorwärts blättern
Anzeige
HERBERS
Excel-Forum (Archiv)
20+ Jahre Excel-Kompetenz: Von Anwendern, für Anwender
Inhaltsverzeichnis

doppelte löschen (Original und Duplikat)

doppelte löschen (Original und Duplikat)
22.06.2009 12:10:39
Tom
Hallo,
ich möchte meine Listen säubern und benötige einen Code der nicht nur das Duplikat löscht sondern auch das original. Es soll dann die gazne Zeile gelöscht werden.
Danke
Tom

2
Beiträge zum Forumthread
Beiträge zu diesem Forumthread

Betreff
Datum
Anwender
Anzeige
AW: doppelte löschen (Original und Duplikat)
22.06.2009 12:34:02
Christoph
Probier's doch mal indem du eine Hilfsspalte einfügst. Dort kannst du dann durch =Zählenwenn(...) ausgeben wie oft dein Wert vorkommt. Anschliessend löscht du einfach alle Werte, bei denen eine 2 (oder noch mehr) gezählt wurde. Am besten du sortierst dann auch direkt noch...
Ist zwar nicht die eleganteste Lösung, aber eine recht schnelle und einfache...
Gruß
Christoph
AW: doppelte löschen (Original und Duplikat)
22.06.2009 12:57:57
fcs
Hallo Tom,
geht etwa so, wenn du eine Spalte nach doppelten Werten durchsuchen möchtest.
Gruß
Franz

Sub DoppelteKomplettLoeschen()
Dim wks As Worksheet, lngSpalteMark As Long
Dim lngZeile As Long, lngZeileLast As Long, SpalteSuch As Long
SpalteSuch = 1 'nach doppelten Werten zu durchsuchende Spalte
Set wks = ActiveSheet
With wks
lngSpalteMark = .Cells.SpecialCells(xlCellTypeLastCell).Column + 1
lngZeileLast = .Cells(.Rows.Count, SpalteSuch).End(xlUp).Row
'Zu löschende Zeilen markieren
Application.ScreenUpdating = False
For lngZeile = 1 To lngZeileLast
If Application.WorksheetFunction.CountIf(.Range(.Cells(1, SpalteSuch), _
.Cells(lngZeileLast, SpalteSuch)), .Cells(lngZeile, SpalteSuch).Value) > 1 Then
.Cells(lngZeile, lngSpalteMark) = "X"
End If
Next
'Zeilen mit Markierung löschen
If Application.WorksheetFunction.CountIf(.Range(.Cells(1, lngSpalteMark), _
.Cells(lngZeileLast, lngSpalteMark)), "X") > 1 Then
.Columns(lngSpalteMark).SpecialCells(xlCellTypeConstants).EntireRow.Delete
End If
Application.ScreenUpdating = True
End With
End Sub


Anzeige

Beliebteste Forumthreads (12 Monate)

Anzeige

Beliebteste Forumthreads (12 Monate)

Anzeige
Anzeige
Anzeige