PDA

Vollständige Version anzeigen : Doppelte Zeilen (Duplikate) löschen


testuserxxl
01.07.2015, 13:49
Hallo :)

ich habe hier ein Problem bei meinem vba-Code, der Zeilen innerhalb einer Tabelle vergleichen und doppelte löschen soll. Eine Löschung soll nur erfolgen, wenn jede Spalte in der Zeile identisch ist.

Mit meinem Code funktioniert dies auch, allerdings wird nur die Spalte A überprüft/verglichen. Hat jemand eine Idee, wie ich was anpassen muss, damit die ganze Zeile berücksichtigt wird? :)

Hier der Code:

Sub Duplikate()
Sheets(4).Rows(1).Select
Do Until ActiveCell.Value = ""
If ActiveCell.Value = ActiveCell.Offset(1, 0).Value Then
ActiveCell.EntireRow.Delete
Else
ActiveCell.Offset(1, 0).Select
End If
Loop
End Sub

Liebe Grüße
Madeleine :)

Heinecoast
01.07.2015, 14:27
Hallo Madeleine,

der Code sollte funktionieren,
allerdings löscht er sobald eine leere Zelle kommt und davor alle Werte dieser Reihe gleich waren und er stoppt sobald in Spalte A eine Leere Zelle auftaucht.



Sub Duplikat()

Dim x As Long
Dim y As Long

x = 1
y = 1

Do

If Cells(x, y + 1).Value = "" Then

Cells(x, y).EntireRow.Delete
y = 1
ElseIf Cells(x, y).Value = Cells(x, y + 1).Value Then
y = y + 1
Else
x = x + 1
y = 1

End If

Loop Until y = 1 And Cells(x, y).Value = ""

End Sub



Hoffe das Hilft dir.

Falls du noch fragen hast einfach melden.

testuserxxl
01.07.2015, 14:36
Hallo Sebastian :)

vielen Dank für deine Antwort.
Beim Ausführen des Codes tut sich leider gar nichts.
Es soll das Tabellenblatt 4 auf Duplikate überprüft werden.

Was meinst du mit: "allerdings löscht er sobald eine leere Zelle kommt und davor alle Werte dieser Reihe gleich waren" ?

Liebe Grüße :)

Heinecoast
01.07.2015, 16:00
Hallo Madeleine,

dachte du hast das Tabellenblatt ausgewählt
einfach diesen Code vor der Schleife einfügen.
Dann Sollte es funktionieren.


ThisWorkbook.Sheets(4).Activate
...



Ich meine damit wenn eine zeile zum Beispiel wie folgt aussieht

A B C D
1 1 - 3

dann wird sie gelöscht. Es dürfen also keine leeren Zellen vorhanden sein.

testuserxxl
01.07.2015, 16:14
Hey,

ich hab den Code entsprechend angepasst, aber es tut sich rein gar nichts beim ausführen. Hab in im Tabellenblatt4 aktuell 290 Zeilen und 104 Spalten.

Es kommt auch keine Fehlermeldung :(


Sub Duplikat()

Dim x As Long
Dim y As Long

x = 1
y = 1

ThisWorkbook.Sheets(4).Activate

Do

If Cells(x, y + 1).Value = "" Then

Cells(x, y).EntireRow.Delete
y = 1
ElseIf Cells(x, y).Value = Cells(x, y + 1).Value Then
y = y + 1
Else
x = x + 1
y = 1

End If

Loop Until y = 1 And Cells(x, y).Value = ""

End Sub

RPP63neu
01.07.2015, 16:26
Hallo!
Warum nicht einfach Daten, Duplikate entfernen?
Dazu Hilfsspalte (bei mir F, so dass die linken 5 Spalten überprüft werden).
a) In F2: =WENN(ZÄHLENWENN(A2:E2;E2)=5;E2;Zeile())
b) Oder: =WENN(ZÄHLENWENN(A2:E2;E2)=5;0;Zeile())
(jeweils nach unten ziehen)

Duplikate entfernen in F entfernt
a) die Duplikate, wobei z.B. aaaaa und bbbbb stehen bleiben
b) alle Duplikate, die identischen Inhalt in A:E haben (aus a) würde auch bbbbb gelöscht werden)

Du willst wahrscheinlich die zweite Lösung haben.

Gruß Ralf

Heinecoast
01.07.2015, 16:51
Hallo Madeleine,

denke habe dein Problem nicht ganz verstanden, was soll genau gelöscht werden?

Eine Zeile wo jede Zelle den selben Wert hat?
Dafür ist mein Makro gedacht.
Oder eine Zeile die an anderer Stelle nochmal vorkommt?

testuserxxl
01.07.2015, 17:00
Hey Sebastian, hey Ralf,

danke für eure Posts.

@Sebastian: die zweite Variante - Zeilen, die identisch noch einmal irgendwo auftauchen (in meinem Fall sind identische Zeilen immer untereinander), sollen gelöscht werden.

@Ralf: gute Idee, aber ich würde eine vba- basierte Lösung bevorzugen ;)

Liebe Grüße
Madeleine

RPP63neu
01.07.2015, 17:10
Hi Madeleine!
Dies sei Dir unbenommen.
Meine Variante dürfte mindestens 1000mal schneller sein!
Stelle doch mal eine Datei zur Verfügung und markiere die Zeilen (durch x) welche gelöscht werden sollen.
Excel-Bordmittel kann man ja auch per VBA nachstellen!

Gruß Ralf

Heinecoast
01.07.2015, 17:29
Hallo Madeleine,

dann so.
Vorraussetzung gleiche Zeilen folgen aufeinander, und es gibt keine leere Zellen innerhallb des Datenbereiches.



Sub Duplikat()

Dim x As Long
Dim y As Long

x = 1
y = 1

ThisWorkbook.Sheets(4).Activate

Do

If Cells(x, y).Value = "" Then
Cells(x, y).EntireRow.Delete
y = 1
ElseIf Cells(x, y).Value = Cells(x + 1, y).Value Then

y = y + 1
Else
x = x + 1
y = 1

End If

Loop Until y = 1 And Cells(x, y).Value = ""

End Sub

testuserxxl
02.07.2015, 10:03
Vielen lieben Dank Sebastian, deine Lösung funktioniert perfekt :)

Dir auch noch mal Danke Ralf!

Liebe Grüße
Madeleine