VBA - FILTERED列で重複を削除する

Question

特定の列で重複を削除する簡単な方法を探していますが、これはフィルタリングされた範囲内です。ですから、基本的には表示されている重複値を削除するだけですが、残りは「フィルタリングされずに隠された」状態にしておきます。

私は、コードのこの部分を持っているし、そうするように、それを変更する方法は考えている：

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

あなたが助けてくださいもらえますか？既存のコードを編集する簡単な方法はありますか？例えば

*：

• 列A =大陸
• 列B =国
• 列C =市

私はインド（コルB）によって国をフィルタリングする場合はIさまざまな都市を何度も繰り返して見てください（C〜C）。私は重複を削除し、各都市の1つだけを見たいと思います。しかし、私は重複が他の国のために削除する必要はありません。*

Answer 1

あなたのRemoveDuplicates引数内のすべての3を指定してをフィルタリングすることなく、すべての大陸・国・都市の組み合わせのための重複を削除することができます。これはあなたの質問に正確に答えているわけではありませんが、あなたが必要とする解決策が1つ少なくなるかもしれません。

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

注Array部分が範囲から列1、2、および3を指定：列A、B、及び大陸、国、および以下についてどのように市としてCを使用して例えば

（既存のコードの列3ではなく）3つの列全体で重複を探します。

マクロでは「元に戻す」が許可されていないため、これをデータのコピーでテストすることをお勧めします。

サンプルのスクリーンショットです。元のリストは右側にあり、結果リストは左側（列A〜C）にあります。 「ロンドン」と「バーミンガム」注意：

Answer 2

あなたはRangeオブジェクトのプロパティSpecialCells(xlCellTypeVisible)後かもしれません。したがって、コードは次のようになります。

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

フィルタを削除すると、空の行が残ります。私が知っている唯一の他の方法（空の行を残さない）は、独自の重複検索ルーチンで重複を削除することです。 SpecialCellsプロパティは、フィルタされたデータのみをチェックするために使用できます。このようなもの：

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

多分あなたはカスタムVBA dup-removerが必要です。これを試してみてください：

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 

テスト

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