Ich versuche, ein schlankes und fehlersicheres Makro zu entwickeln, um Zeilen mit doppelten Werten in Spalte A zu löschen. Ich habe zwei Lösungen und beide haben ihre Vorteile. Keiner von ihnen ist genau das, was ich will.

Ich muss Zeilen mit Duplikaten löschen, aber die letzte Zeile mit dem Duplikat belassen.

  1. Dieser ist großartig. Es hat keine Schleife und funktioniert sofort. Das Problem ist, dass nachfolgende Zeilen mit Duplikaten gelöscht werden und somit das erste Auftreten des Duplikats verbleibt (und ich brauche das letzte / oder zweite - die meisten werden nur zweimal angezeigt).

    Sub Delete() ActiveSheet.Range("A:E").RemoveDuplicates Columns:=1, Header:=xlNo End Sub

  2. Dieser geht von unten und löscht Duplikate. Es dauert länger als das erste (ich habe ungefähr 6k Zeilen), aber das Problem mit diesem ist, dass es nicht alle löscht. Einige Duplikate bleiben übrig und werden gelöscht, nachdem ich denselben Code erneut ausgeführt habe. Noch weniger Enten sind übrig. Grundsätzlich muss es bis zu 5 mal laufen und dann bekomme ich eine saubere Liste.

    `

    Sub DeleteDup ()

      Dim LastRowcheck As Long, n1 As Long, rowschecktodelete As Long
    
      LastRowcheck = Worksheets("Sheet1").Range("A" & Rows.Count).End(xlUp).Row
    
      For n1 = 1 To LastRowcheck
        With Worksheets("Sheet1").Cells(n1, 1)
          If Cells(n1, 1) = Cells(n1 + 1, 1) Then
            Worksheets("Sheet1").Cells(n1, 1).Select
            Selection.EntireRow.Delete
         End If
       End With
      Next n1
    
      End Sub
    

`Gibt es eine Möglichkeit, diese zu verbessern, um gut zu funktionieren, oder gibt es eine bessere Lösung? Jede Info wird sehr geschätzt. Vielen Dank

0
drLecter 23 Dez. 2015 im 05:01

2 Antworten

Beste Antwort

Das Konzept ist richtig, aber denken Sie daran, dass Cells(n1 + 1, 1) beim Löschen von Zeilen nicht mehr dasselbe ist wie vor dem Löschen einer Zeile. Die Lösung besteht darin, einfach die Schleife umzukehren und die Zeilen von unten nach oben zu testen:

Sub DeleteDup()
    Dim last As Long
    Dim current As Long
    Dim sheet As Worksheet

    Set sheet = Worksheets("Sheet1")
    With sheet
        last = .Range("A" & .Rows.Count).End(xlUp).Row
        For current = last To 1 Step -1
            If .Cells(current + 1, 1).Value = .Cells(current, 1).Value Then
                .Rows(current).Delete
            End If
        Next current
    End With
End Sub

Beachten Sie, dass Sie den Schleifenzähler verwenden können, um .Rows zu indizieren, anstatt das Objekt Selection zu verwenden, um die Leistung erheblich zu verbessern. Wenn Sie einen Verweis auf Worksheet abrufen und das Ganze in einen With Block werfen, müssen Sie Worksheets("Sheet1") nicht ständig dereferenzieren, was ebenfalls die Leistung verbessert.

Wenn es immer noch zu langsam läuft, besteht der nächste Schritt darin, Zeilen zum Löschen zu markieren, nach dem Flag zu sortieren, den gesamten markierten Bereich in einem Vorgang zu löschen und dann in die ursprüngliche Reihenfolge zurückzusortieren. Ich vermute, dass der obige Code schnell genug für ~ 6K Zeilen sein sollte.

1
Comintern 23 Dez. 2015 im 02:28

Am einfachsten wäre es, alle Zeilen gleichzeitig zu löschen. Um die Geschwindigkeit zu erhöhen, sollten Sie Ihre Überprüfungen besser mit Variablen durchführen und nicht mit den tatsächlichen Zellenwerten wie folgt:

Sub DeleteDup()

  Dim LastRowcheck As Long
  Dim i As Long
  Dim rows_to_delete As Range
  Dim range_to_check As Variant

  With Worksheets("Sheet1")
    LastRowcheck = .Cells(Rows.Count, 1).End(xlUp).Row
    range_to_check = .Range("A1:A" & LastRowcheck).Values

    For i = 1 To LastRowcheck - 1
      If range_to_check(i, 1) = range_to_check(i + 1, 1) Then
        If rows_to_delete Is Nothing Then
          Set rows_to_delete = .Cells(i, 1)
        Else
          Set rows_to_delete = Union(.Cells(i, 1), rows_to_delete)
        End If
      End If
    Next n1
  End With

  rows_to_delete.EntireRow.Delete

End Sub
2
Dirk Reichel 23 Dez. 2015 im 03:01