VBA - Löschen von Duplikaten in einer FILTERED-Spalte

Question

Ich suche nach einer schnellen Möglichkeit, Duplikate in einer bestimmten Spalte zu löschen, aber nur in einem gefilterten Bereich. Also, im Grunde möchte ich nur sichtbare Duplikate löschen, aber den Rest "ungefiltert und versteckt" lassen.

Ich habe dieses Stück Code und haben keine Ahnung, wie es zu ändern, dies zu tun:

ActiveSheet.Range("A:ZZ").RemoveDuplicates Columns:=Array(3), Header:=xlYes 

Könnten Sie bitte helfen? Gibt es eine einfache Möglichkeit, den vorhandenen Code dafür zu bearbeiten?

* Zum Beispiel:

• Spalte A = Kontinent
• Spalte B = Land
• Spalte C = Stadt

Wenn ich das Land von Indien Filter (col B) I siehe verschiedene Städte, die oft wiederholt wurden (Spalte C). Ich möchte Duplikate löschen und nur eine von jeder Stadt sehen. Allerdings möchte ich nicht die Duplikate für die anderen Länder gelöscht werden. *

Answer 1

Sie können ohne Filterung Duplikate für alle Kontinent-Land-Stadt-Kombinationen entfernen, indem sie alle drei in Ihre RemoveDuplicates Argumente angeben. Dies beantwortet nicht genau Ihre Frage, aber es könnte die Lösung sein, die Sie mit einem Schritt weniger benötigen.

Für Ihr Beispiel mit Spalten A, B und C als Kontinent, Land und Stadt, wie etwa die folgenden:

ActiveSheet.Range("A:C").RemoveDuplicates Columns:=Array(1, 2, 3), Header:=xlYes 

Hinweis des Array Teil gibt die Spalten 1, 2 und 3 aus dem Bereich ausgewertet werden, die nach Duplikaten in allen 3 Spalten suchen (anstatt nur Spalte 3 aus Ihrem vorhandenen Code).

Ich würde vorschlagen, dies auf einer Kopie Ihrer Daten zu testen, da Makros "rückgängig machen" nicht zulassen.

Hier ist ein Screenshot eines Beispiels. Die ursprüngliche Liste befindet sich auf der rechten Seite, und die resultierende Liste befindet sich auf der linken Seite (in den Spalten A-C). Hinweis "London" und "Birmingham":

Answer 2

Sie nach dem SpecialCells(xlCellTypeVisible) Eigenschaft des Range Objekt sein könnte. So könnte Ihr Code sein:

Es bleibt leere Zeilen, obwohl, sobald Sie den Filter entfernen. Der einzige andere Weg, den ich kenne (der keine leeren Zeilen übrig lässt), ist, die Duplikate mit Ihrer eigenen Duplikatsuchroutine zu entfernen. Die Eigenschaft SpecialCells kann weiterhin verwendet werden, um nur gefilterte Daten zu prüfen. Etwas wie dieses:

Dim uniques As Collection 
Dim cell As Range, del As Range 
Dim exists As Boolean 
Dim key As String 

Set uniques = New Collection 
For Each cell In ActiveSheet.Range("A:ZZ").Columns(3).SpecialCells(xlCellTypeVisible).Cells 
    key = CStr(cell.Value2) 
    exists = False 
    On Error Resume Next 
    exists = uniques(key) 
    On Error GoTo 0 
    If Not exists Then 
     uniques.Add True, key 
    Else 
     If del Is Nothing Then 
      Set del = cell 
     Else 
      Set del = Union(del, cell) 
     End If 
    End If 
Next 
If Not del Is Nothing Then 
    del.EntireRow.Delete 
End If 

Answer 3

Vielleicht brauchen Sie eine benutzerdefinierte VBA-DUP-Remover.Versuchen Sie folgendes:

Sub RemoveVisibleDupes(r As Range, comparedCols) 
    Dim i As Long, j As Long, lastR As Long 
    i = r.Row: lastR = r.Row + r.Rows.count - 1 
    Do While i < lastR 
     For j = lastR To i + 1 Step -1 
      If Not (r.Rows(i).Hidden Or r.Rows(j).Hidden) And areDup(r.Rows(i), r.Rows(j), comparedCols) Then 
       r.Rows(j).Delete 
       lastR = lastR - 1 
      End If 
     Next 
    i = i + 1 
    Loop 
End Sub 

Function areDup(row1 As Range, row2 As Range, comparedCols) As Boolean 
    Dim col 
    For Each col In comparedCols 
     If row1.Cells(col).Value <> row2.Cells(col).Value Then Exit Function 
    Next 
    areDup = True 
End Function 

Testing

Sub TestIt() 
    On Error GoTo Finish 
    Application.DisplayAlerts = False: Application.EnableEvents = False: Application.ScreenUpdating = False 

    ' call our custom dup-remover on filtered columns A:C with comparing columns 1 and 3 
    RemoveVisibleDupes Sheet2.Range("A1:C" & Sheet2.Cells(Sheet2.Rows.count, 1).End(xlUp).Row), Array(1, 3) 
    ' To use it with one column only, say 3, replace Array(1, 3) with array(3) 

Finish: 
    Application.DisplayAlerts = True: Application.EnableEvents = True: Application.ScreenUpdating = True 
End Sub