Duplikate entfernen letzten Eintrag behalten

Forumthread: Duplikate entfernen letzten Eintrag behalten

08.05.2026 17:15:02

Christian

Hallo,
ich würde gerne fragen, wie sich mein Problem, bevorzugt mit VBA, lösen lässt.
VBA weil ich bereits einen Code habe, dem ich die Lösung des Problems gern mit Call ... hinzufügen würde.

Es geht um folgendes. Habe einen Bereich alle!A:D mit knapp 370Tsd Zeilen und möchte gerne Duplikate entfernen mit Spalten B und C als Kriterium.
Jetzt habe ich nur ein Problem .Range("A1:D" & lrAlle).RemoveDuplicates Columns:=Array(2, 3), Header:=xlNo behält immer den ersten Eintrag und löscht alle weiteren.
Ich würde aber gerne folgende Regel aufstellen, wenn der Text in Spalte C auf jpg endet, behalte den letzten Eintrag und lösch die vorherigen, wenn der Text auf html endet, behalte den ersten und lösche die nachfolgenden.
Texte mit anderen Endungen gibt es nicht.

Wie lässt sich das lösen?
Danke
Christian

10
Beiträge zum Forumthread

Beiträge zu diesem Forumthread

Betreff

Datum

Anwender

bevor ihr fragt

08.05.2026 17:16:09

Christian
AW: Duplikate entfernen letzten Eintrag behalten

09.05.2026 12:16:30

Piet
AW: Danke an RPP63 für dieses tolle Makro, Hut ab .... oWt

10.05.2026 14:09:27

Piet
AW: Duplikate entfernen letzten Eintrag behalten

09.05.2026 13:53:03

Christian
Dauer

10.05.2026 12:00:12

RPP63
AW: Dauer

10.05.2026 14:14:58

Christian
Testergebnis

10.05.2026 19:15:18

Christian
AW: bevor ihr fragt

08.05.2026 18:25:03

daniel
AW: bevor ihr fragt

08.05.2026 18:33:03

daniel
AW: bevor ihr fragt

08.05.2026 21:25:53

Christian

bevor ihr fragt

08.05.2026 17:16:09

Christian

bei den Texten die auf jpg enden gibt es Unterschiede in der Groß/Kleinschreibung

AW: Duplikate entfernen letzten Eintrag behalten

09.05.2026 12:16:30

Piet

Hallo

mit VBA sollte es so gehen, ohne zu sortieren!
Wie lange der Code bei 370tsd läuft kann ich nicht sagen?
Es sei denn du benutzt 2 Zellen um die Zeiten zu notieren, z.B. F1,F2

mfg Piet

Sub Doppelte_löschen()

Dim lz As Long, j As Long, i As Long

[f1,f2] = Time    'Nur zur Zeitmessung!

lz = Cells(Rows.Count, 1).End(xlUp).Row

For j = lz To 2 Step -1

   If LCase(Cells(j, 3)) = LCase(Cells(j - 1, 3)) Then

      '1. html stehen lassen

      If LCase(Cells(j, 3)) = "html" Then

         Rows(j).Delete shift:=xlUp

      ElseIf LCase(Cells(j, 3)) = "jpg" Then

      'letzte jpg stehen lassen

         For i = j - 1 To 2

             Rows(i).Delete shift:=xlUp

             If LCase(Cells(i - 1, 3)) > "jpg" Then Exit For

         Next i

      End If

   End If

Next j

[f2] = Time    'Nur zur Zeitmessung!

End Sub

AW: Danke an RPP63 für dieses tolle Makro, Hut ab .... oWt

10.05.2026 14:09:27

Piet

...

AW: Duplikate entfernen letzten Eintrag behalten

09.05.2026 13:53:03

Christian

Hallo Piet,

vielen Dank für deine Lösung,

ich sag es mal so, wie VBA das löst, ob mit Daniels Formel oder ohne Formel ist mir relativ gleich, hauptsache ich kann es wie ich bereits angedeutet hatte im Rahmen eines anderen bestehenden Makros laufen lassen.

Was jetzt schneller ist, werden dann meine Tests zeigen.

Gruß
Christian

Dauer

10.05.2026 12:00:12

RPP63

Moin!
Nö, ich werde nicht ausprobieren, wie lang eine rückwärtige Schleife mit Zellzugriff über 300K Zeilen nebst Löschungen benötigt.
Dürfte zig Minuten dauern …
Hingegen ist Daniels Methode mit Sortieren und Duplikate entfernen pfeilschnell!

Wir basteln uns mal eine Beispieldatei mit 100.000 Zeilen.
• Spalte A Buchstaben A-D
• Spalte B Buchstaben E-H mit den möglichen Endungen .jpg und .html
• Spalte C mit Daniels Formelvorschlag
• Dies ergibt 4*4 html-Unikate und 4*4 jpg-Unikate (also 32) auf 100.000 Zeilen.

Sub Fill_It()

Cells.Delete

Cells(1).Resize(, 3) = Array("Sp1", "Sp2", "Sp3")

Cells(2, 1).Formula2 = "=CHAR(RANDARRAY(100000,,65,68,1))"

Cells(2, 2).Formula2 = _

  "=CHAR(RANDARRAY(100000,,69,72,1))&INDEX({"".html"","".jpg""},RANDARRAY(100000,,1,2,1))"

Cells(2, 3).Resize(100000).Formula = "=IF(RIGHT(B2,3)=""jpg"",ROW(),1/ROW())"

With Cells(1).CurrentRegion

  .Copy

  .PasteSpecial xlPasteValues

  .HorizontalAlignment = xlCenter

  .NumberFormat = "[1]0.000;General"

  .Columns.AutoFit

End With

Application.Goto Cells(1)

End Sub

Folgendes Makro behält die letzten jpg- und die ersten html-Unikate,
Dauer: 0,4 Sekunden!

Sub letzte_Eindeutige_jpg_erste_eindeutige_html()

Dim Start#

Start = Timer

With Range("A1").CurrentRegion

  .Sort .Cells(3), xlDescending, Header:=xlYes

  .RemoveDuplicates Array(1, 2)

End With

With Range("A1").CurrentRegion

  .Sort Range("B2"), , Range("A2"), Header:=xlYes

End With

Debug.Print Timer - Start

End Sub

Gruß Ralf

AW: Dauer

10.05.2026 14:14:58

Christian

Hallo Ralf,

Dank dir für deine Mühe. Sitze leider im Zug, kann es leider erst morgen testen, bin auf dem Weg zu den eltern, muttertag. Aber du wirst Rückmeldung bekommen, versprochen.

Gruß
Christian

Testergebnis

10.05.2026 19:15:18

Christian

Hallo Ralf,

nocmla vielen Dank. Hat ne ganze Weile gedauert, bis ich verstanden habe, was Sub Fill_It vor allem CHAR(RANDARRAY macht, bis ich rausgefunden habdass das 100000 zufällige Buchstaben von A bis D erzeugt.

Meine eigene Version, die ich gebaut hatte, war bereits von der Logik her ähnlich, aber deutlich umständlicher geschrieben.

Die aktuelle Version ist jetzt:

Option Explicit

Public Sub Makro9()



    Dim ws As Worksheet

    Dim lastRow As Long

    

    Set ws = ActiveSheet

    

    With Application

        .ScreenUpdating = False

        .EnableEvents = False

        .Calculation = xlCalculationManual

    End With

    

    lastRow = ws.Cells(ws.Rows.count, "A").End(xlUp).row

    

    If lastRow >= 2 Then

    

        ' Hilfsspalte

        With ws.Range("E1:E" & lastRow)

            .FormulaLocal = "=WENN(RECHTS(C1;3)=""jpg"";1/ZEILE();ZEILE())"

            .Value = .Value

        End With

        

        ' Sortierung für gewünschtes Behalten

        With ws.Sort

            .SortFields.Clear

            

            .SortFields.Add ws.Range("B1:B" & lastRow), xlSortOnValues, xlAscending

            .SortFields.Add ws.Range("C1:C" & lastRow), xlSortOnValues, xlAscending

            .SortFields.Add ws.Range("E1:E" & lastRow), xlSortOnValues, xlDescending

            

            .SetRange ws.Range("A1:E" & lastRow)

            .Header = xlNo

            .Apply

        End With

        

        ' Duplikate entfernen

        ws.Range("A1:E" & lastRow).RemoveDuplicates Columns:=Array(2, 3), Header:=xlNo

        

        ' Neue letzte Zeile

        lastRow = ws.Cells(ws.Rows.count, "A").End(xlUp).row

        

        ' Optional zurücksortieren

        With ws.Sort

            .SortFields.Clear

            

            .SortFields.Add ws.Range("D1:D" & lastRow), xlSortOnValues, xlAscending

            .SortFields.Add ws.Range("C1:C" & lastRow), xlSortOnValues, xlAscending

            

            .SetRange ws.Range("A1:E" & lastRow)

            .Header = xlNo

            .Apply

        End With

        

        ' Hilfsspalte entfernen

        ws.Columns("E").Delete

    

    End If

    

    With Application

        .ScreenUpdating = True

        .EnableEvents = True

        .Calculation = xlCalculationAutomatic

    End With



End Sub

AW: bevor ihr fragt

08.05.2026 18:25:03

daniel

Hi
wenn du mit Duplikate-Entfernen arbeitest, musst du so sortieren, dass die Zeile, die stehenbleiben soll, oben steht.
Wenn du jetzt, außer der vorliegenden Reihenfolge kein greifbares Sortierkritierum hast, dann könntest du dir so behelfen:

in einer Hilfsspalte fügst du die Zeilennummer hinzu und bei einem JPG den Kehrwert der Zeilennummer

=Wenn(rechts(C1;3)="jpg";1/Zeile();Zeile())

dann sortierst du vor dem Duplikate-entfernen nach den beiden Kriteriumsspalten und dieser Hilfsspalte.
damit wird dann bei den JPG-Zeilen die Reihenfolge umgekehrt, so dass die zuvor untere Zeile einer Gruppe jetzt oben steht.

Gruß Daniel

AW: bevor ihr fragt

08.05.2026 18:33:03

daniel

um Groß- und Kleinschreibung anzupassen, gibt es die Textfunktionen KLEIN und GROSS:

Klein("AbCdE") ergbit "abcde"

AW: bevor ihr fragt

08.05.2026 21:25:53

Christian

Hallo Daniel,

erstmal vielen Dank.

Umwandlungen G/K sind nicht mehr nötig, alle Zeilen haben aktuell die Schreibweise, wie ich sie möchte, es wird nur die falsche gelöscht.
Die Regeln welche Buchstaben groß geschrieben sind, sind so kompliziert, damit fange ich erst gar nicht an, es sind jedenfalls nicht alle Buchstaben.

Im Moment dachte ich, was nutzt mir diese Formel, sie dreht doch alle Duplikate um, bis mir dann die Schuppen von den Augen gefallen sind und mir klar wurde, wenn in beiden Fällen alles klein geschrieben ist, ist die Reihenfolge egal.

Die Tabelle temporär anders zu sortieren, wie du sagtest ist auch kein Problem, die ursprüngliche Sortierung ist problemlos wiederherstellbar.

Also alles in allem, eine funktionierende Methode.

Jetzt muss ich es nur noch schaffen, das ganze mit VBA zu automatisieren. Aber sortieren und ne Formel einfügen und dann nochmal sortieren, ich denke das bekomme ich auch ohne eure Hilfe hin.

Vielen Dank und ein schönes Wochenende
Christian

Duplikate entfernen letzten Eintrag behalten

Forumthread: Duplikate entfernen letzten Eintrag behalten

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

10
Beiträge zum Forumthread

Beiträge zu diesem Forumthread