Anzeige
Anzeige
HERBERS
Excel-Forum (Archiv)
20+ Jahre Excel-Kompetenz: Von Anwendern, für Anwender
Inhaltsverzeichnis

Zeilen mit gleichem Inhalt löschen

Zeilen mit gleichem Inhalt löschen
15.04.2016 14:40:33
Gregor

Hallo zusammen
Ich habe bereits im Forum recherchiert, habe aber keine Lösung für mein Problem gefunden.
Ich will in einer Tabelle Zeilen mit gleichem Inhalt in den Spalte 12 bis Spalte 52 löschen. In den Spalten 1 bis 11 stehen unterschiedliche Einträge, zum Teil sind diese auch leer. Bei gleichem Inhalt Spalte 12 bis Spalte 52 sollen immer die folgenden Zeilen und immer die ganzen Zeilen gelöscht werden.
Kann ich das mit einem Makro lösen?
Vielen Dank und Gruss
Gregor

10
Beiträge zum Forumthread
Beiträge zu diesem Forumthread

Betreff
Datum
Anwender
Anzeige
AW: Zeilen mit gleichem Inhalt löschen
15.04.2016 14:46:14
selli
hallo gregor,
Kann ich das mit einem Makro lösen?
ja, das geht per vba.
Ich habe bereits im Forum recherchiert
bei suche nach "zeilen löschen" gibt es im archiv 168 beiträge.
gruß
selli

AW: Zeilen mit gleichem Inhalt löschen
15.04.2016 15:25:43
Fennek
Hallo,
Teste mal

Activesheet.range("a1:az" & letzte Zeile).removeduplicates columns:=array(12, 52), header:= _
xlyes
Good luck!
Mfg

AW: Zeilen mit gleichem Inhalt löschen
15.04.2016 17:01:12
Gregor
Hallo
Ja, ich habe gesehen, dass es darüber viele Einträge gibt. Ich finde jedoch nur Vorschläge, in denen Inhalte in einzelnen Spalten verglichen und dann gelöscht werden. Ich möchte aber wie eingangs beschrieben, alle Folgezeilen löschen, in denen die Spalteninhalte einer Zeile in den Spalten 12 bis 52 identisch sind.
Besser noch wäre, wenn alle Folgezeilen gelöscht werden, die von 12 bis 52 die gleichen Inhalte haben, aber in unterschiedlichen Spalten stehen.
Den Vorschlag von Fenneck habe ich getestet, es werden aber zu viele Zeilen gelöscht, ich kann nicht feststellen welche wieso genau.
Danke und Gruss
Gregor

Anzeige
AW: Zeilen mit gleichem Inhalt löschen
15.04.2016 17:53:44
Fennek
Hallo Gregor,
der Code löscht alle Duplikate, falls es noch einige Zeilen gibt, die in den Spalten 11-52 leer sind, aber in andere Bereichen Werte haben, würden diese auch gelöscht.
Mfg

AW: Zeilen mit gleichem Inhalt löschen
18.04.2016 12:13:45
Gregor
Hallo Fennek
Danke für die Präzisierung.
Es dürfen aber nur Zeilen gelöscht werden, bei denen in den Spalten 12 bis 52 der gleiche Inhalt steht (unabhängig in welcher Spalte). Ich habe im Forum einen guten Code gefunden. Dieser müsste aber noch so verändert werden, dass nicht Spalte um Spalte verglichen wird, sondern der Inhalt der Spalten 12 bis 52, unabhängig davon, in welcher Spalte die Einträge sind. Das heisst, die Reihenfolge der Einträge kann variieren und das muss berücksichtigt werden.
Beispiel:
Zeile 4 = AAGS 2 27 28 29 ZVB 22
Zeile 5 = ZVB 22 AAGS 2 27 28 29
Zeile 5 müsste gelöscht werden.
Kann dieser Code entsprechend angepasst werden:
Sub DelDuplicate2()
Dim LastRow As Long
Dim LastCol As Long
Dim x1 As Variant, x2 As Variant
Dim y1 As String, y2 As String
Dim i As Long, k As Long
LastRow = Cells(Rows.Count, 12).End(xlUp).Row
LastCol = 52
For i = LastRow To 2 Step -1
x1 = Cells(i, 12).Value
x2 = Cells(i - 1, 12).Value
If x1 = x2 And Not IsEmpty(x2) Then
y1 = x1
For k = 12 To LastCol
y1 = y1 & "-" & Cells(i, k)
Next k
y2 = x2
For k = 12 To LastCol
y2 = y2 & "-" & Cells(i - 1, k)
Next k
If y1 = y2 Then
Range(Cells(i, 1), Cells(i, LastCol)).Delete Shift:=xlUp
End If
End If
Next i
End Sub
Vielen Dank und Gruss
Gregor

Anzeige
Zeilen Löschen mit Schleife
18.04.2016 19:07:12
Michael
Hi zusammen,
das sollte es tun: https://www.herber.de/bbs/user/105056.xls
Das Makro:
Option Explicit
Private Sub CommandButton1_Click()
Dim LastRow As Long
Dim LastCol As Long, LCres As Long
Dim x1 As Variant, x2 As Variant
Dim y1 As String, y2 As String
Dim i As Long, k As Long, jmax1&, jmax2&, j1&, j2&, j&
Dim z1 As Variant, z2 As Variant, ausgabe As Variant
Dim gerade As Boolean, gefunden As Boolean
Dim c As Range
LastRow = Cells(Rows.Count, 12).End(xlUp).Row
LastCol = 52: LCres = LastCol - 11
ausgabe = Range("BA1").Resize(LastRow, 1)
gerade = False
Range("L" & 1).Resize(, LCres).Interior.Color = vbYellow
MsgBox "zunächst wurde gefärbt, um den Bereich zu überprüfen"
ausgabe(2, 1) = 2
z1 = Range("L" & 2).Resize(, LCres)
For i = 3 To LastRow
If gerade Then
z1 = Range("L" & i).Resize(, LCres)
Else
z2 = Range("L" & i).Resize(, LCres)
End If
gerade = Not gerade
ausgabe(i, 1) = i
j = 0
' zuerst werden Nicht-Leere "nach oben" sortiert
For k = 1 To LCres
If Not IsEmpty(z1(1, k)) Then
j = j + 1
z1(1, j) = z1(1, k)
End If
Next
jmax1 = j
'       Stop
j = 0
For k = 1 To LCres
If Not IsEmpty(z2(1, k)) Then
j = j + 1
z2(1, j) = z2(1, k)
End If
Next
jmax2 = j
' WENN gleich viel Zellen MIT Werten
If jmax1 = jmax2 Then
For j1 = 1 To jmax1
gefunden = False
For j2 = 1 To jmax2
If z1(1, j1) = z2(1, j2) Then
gefunden = True
Exit For
End If
Next
If Not gefunden Then Exit For
Next
Else
gefunden = False
End If
If gefunden Then ausgabe(i, 1) = LastRow + 1
Next i
Range("BA1").Resize(LastRow, 1) = ausgabe
MsgBox "Die Werte wurden in Spalte BA geschrieben"
Range("A2:BA" & LastRow).Sort key1:=Range("BA2")
MsgBox "und sortiert"
'Stop
Set c = Range("BA2:BA" & LastRow).Find(LastRow + 1)
If Not c Is Nothing Then
c.Interior.Color = vbGreen
MsgBox "Ab Zelle " & c.Address & " wird gelöscht"
Rows(c.Row & ":" & LastRow).EntireRow.Delete
End If
End Sub
Schöne Grüße & Antwort erbeten,
Michael

Anzeige
AW: Löschen mit RemDuplicates (voher sortieren)
18.04.2016 22:30:42
Daniel
Hi
das wird u.U. Aufwendig.
der einfachste Weg diese Aufgabe zu lösen dürfte folgendes sein:
1. Spalte 12-52 kopieren und daneben (gleiche Zeilen) nochmal einfügen.
2. kopierten Bereich jede Zeile für sich spaltenweise sortieren, so dass bei gleichen Spalten gleiche Inhalte auch an der gleichen Stelle stehen.
3. dann kannst du das ganze mit RemoveDuplicates bereinigen.
ein Codebeispiel.
der Code läuft so nur im aktiven Tabellenblatt.
damit ich für das RemoveDuplicates nicht 41 Werte angeben muss, fasse ich die Spalteninhalte zu einem Text zusammen, so dass das RemoveDuplicates nur eine Prüfspalte hat:
Sub Duplikate_Löschen_bei_unsortierten_Spalten()
Dim rngZeile As Range
Const StartSpalte As Long = 12
Const AnzahlSpalten As Long = 41
With ActiveSheet.UsedRange
'--- Kriteriumsspalten kopieren
.Columns(StartSpalte).Resize(, AnzahlSpalten).Copy
.Columns(.Columns.Count + 1).PasteSpecial xlPasteValues
With Selection
'--- kopierten Bereich sortieren
For Each rngZeile In .Rows
rngZeile.Sort key1:=rngZeile.Cells(1, 1), _
order1:=xlAscending, _
Header:=xlNo, _
Orientation:=xlSortRows
Next
With .Columns(.Columns.Count + 1)
'--- Spaltenwerte in einen Wert zusammenfassen mit UDF
.FormulaR1C1 = "=verbinden(RC[-" & AnzahlSpalten & "]:RC[-1])"
.Formula = .Value
'--- Duplikate Entfernen
.EntireRow.RemoveDuplicates .Column, xlNo
'--- Aufräumen
.ClearContents
End With
.ClearContents
End With
End With
End Sub
Function verbinden(Zellbereich As Range) As String
With WorksheetFunction
verbinden = Join(.Transpose(.Transpose(Zellbereich)), "_")
End With
End Function
beachte, dass ich hier Zeilen sortiere und nicht wie sonstn üblich Zeilen, und dass sich Excel die zuletzt gemachten Einstellungen beim Sortieren merkt.
Gruß Daniel

Anzeige
AW: Löschen mit RemDuplicates (voher sortieren)
19.04.2016 13:02:49
Gregor
Hallo zusammen
Einfach super, beide Lösungen funktionieren, der Code von Daniel scheint mir etwas einfacher.
Michael und Daniel, vielen Dank.
Gruss Gregor

Vergleich
19.04.2016 18:49:13
Michael
Hi zusammen,
ich habe mal einen Test mit beiden Codes gefahren...
Dabei habe ich festgestellt, daß in meinem Code ein Fehler enthalten war, der mit den paar Beispieldaten nicht aufgetreten war. Den habe ich behoben.
Dadurch ist diese Variante eher noch unübersichtlicher geworden (ich habe mich auch nicht SONDERLICH bemüht, "schön" zu formulieren); insbesondere kommt die For-Schleife zum "Wegsortieren" etwaiger, leerer Zellen drei Mal so gut wie identisch vor, was man eigentlich in eine Function auslagern würde.
Allerdings: eine Function wegen ein paar doppelten Zeilen Code verlangsamt die Ausführung, und Performance ist mir wichtiger als "optische Aufbesserung".
An Daniels Code habe ich mich erst Mal verschluckt, bis ich die Function in ein allg. Modul gesteckt habe - damit läuft es denn problemlos.
In der Datei https://www.herber.de/bbs/user/105082.xls
kann man per Button 500 Zeilen Testdaten erzeugen; ich wollte Daniels "usedrange" nicht beeinträchtigen, deshalb kann man in "Tabelle2"

Anzeige
falschen Button erwischt,
19.04.2016 18:56:46
Michael
mitten im Satz.
Also: ... Deshalb kann man für "Tabelle2" die Sub DatenErzeugen in Modul1 händisch aufrufen oder (zum besseren Vergleich mit identischen Daten) A2:AZ501 händisch über die Zwischenablage von "Tabelle1" rüberkopieren.
Mein fehlerbereinigter Code wurde ebenso wie Daniels mit einer Zeitmessung versehen: Button "Machen(t)", wobei letzterer direkt im VBE zu starten ist.
Viel Spaß,
Michael

351 Forumthreads zu ähnlichen Themen

Anzeige
Anzeige
Anzeige

Beliebteste Forumthreads (12 Monate)

Anzeige

Beliebteste Forumthreads (12 Monate)

Anzeige
Anzeige
Anzeige