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.
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
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
2 Antworten
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.
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
Verwandte Fragen
Neue Fragen
vba
Visual Basic für Applikationen (VBA) ist eine ereignisgesteuerte, objektorientierte Programmiersprache zum Schreiben von Makros, die für die gesamte Office-Suite sowie für andere Anwendungen verwendet wird. VBA entspricht nicht VB.NET oder VBS. Wenn Sie in Visual Studio arbeiten, verwenden Sie [vb.net]. Wenn Ihre Frage speziell die Programmierung einer MS Office-Anwendung betrifft, verwenden Sie auch das entsprechende Tag: [Excel], [MS-Zugriff], [MS-Wort], [Outlook] oder [MS-Projekt].