doppelte Zeilen löschen

Schönen guten Abend an alle,
ich habe folgendes Problem
ein größeres Tabellenblatt mit ca. 10000 Zeilen. In der Spalten A steht immer ein Name, mit den dazu gehörigen Einträgen in der Spalte B und C und .. bis Spalte Q.
Bei ca. 10000 Einträgen wird es immer wieder zu doppelten Einträgen kommen.
Gibt es ein Möglichkeit mit eine Makro nach doppelten Einträgen zu suchen und dann die jeweilige komplette Zeile zu löschen.
z.B in der Zeile
A 5 steht Peter
A 526 steht auch Peter
A 7843 steht auch Peter
es sollen dann die Zeilen A 526 und A 7843 komplett gelöscht werden, so das nur noch die Zeile A5 überbleibt.
Das wird die Datei mit Sicherheit kleiner und übersichtlicher machen.
Gruß Peter

Beiträge zum Forumthread

Beiträge zu diesem Forumthread

Betreff

Datum

Anwender

Sub test() Dim lngZeile As Long For lngZeile = Cells(Rows.Count, 1).End(xlUp).Row To 2 Step -1 If Application.WorksheetFunction.CountIf(Columns(1), Cells(lngZeile, 1).Value) > 1 Then Cells(lngZeile, 1).Value = "TRUE" End If Next On Error Resume Next Columns(1).SpecialCells(xlCellTypeConstants, xlLogical).EntireRow.Delete On Error GoTo 0 End Sub

Hi
wenn es unbedingt VBA sein muss, dann kannst du auch den Spezialfilter mit VBA aufrufen und anschließend die Originaldaten löschen.
das gibt wahrscheinlich den kürzesten und auch schnellsten Code.
der Makrorecorder hilft dir sicherlich dabei, den richtigen Code zu ermitteln.
ansonsten kannst du das hier verwenden, die originalreihenfolge bleibt erhalten.
(hab ich aber schon öfters mal hier gepostet und hätte im Archiv zu finden sein müssen)


Sub Doppelte_Löschen()
Dim Zeile As Long
Zeile = Cells(Rows.Count, 1).End(xlUp).Row
'--- Originalreihenfolge sichern
Columns(1).Insert
With Cells(1, 1).Resize(Zeile)
.FormulaLocal = "=Zeile()"
.Formula = .Value
End With
'--- zu löschende Daten markieren
ActiveSheet.UsedRange.Sort key1:=Cells(1, 2), order1:=xlAscending, header:=xlNo
Columns(1).Insert
Cells(1, 1).Value = Cells(1, 2).Value
With Cells(2, 1).Resize(Zeile - 1)
.FormulaLocal = "=wenn(C2=C1;wahr;B2)"
.Formula = .Value
End With
'--- zurücksortieren und löschen
ActiveSheet.UsedRange.Sort key1:=Cells(1, 1), order1:=xlAscending, header:=xlNo
Columns(1).SpecialCells(xlCellTypeConstants, 4).EntireRow.Delete
'--- Hilfsspalten löschen
Range("A:B").Delete
End Sub

Gruß, Daniel

Beliebteste Forumthreads (12 Monate)

6 Beiträge zum Forumthread Beiträge zu diesem Forumthread

VBA Beispiele zu verwandten Themen

Beliebteste Forumthreads (12 Monate)

Beliebteste Forumthreads (12 Monate)

6
Beiträge zum Forumthread

Beiträge zu diesem Forumthread