Beiträge zum Thread: Duplikate entfernen letzten Eintrag behalten

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

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

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

Klein("AbCdE") ergbit "abcde"

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

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

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

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

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

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

...