Excelマクロ。列に基づいて重複しない行を削除する

Question

Excelでマクロを実行して、非重複を削除して重複を簡単に調べることができます。削除 - それはユニークな場合、それを残す - 列「B」の各セルを通る

ステップは、B2から始まる現在のセルBがどこ列Bに一致している場合、実行中

（B1ヘッダです）行全体

以下のコードは矛盾した結果で実行されています。

データの与えられた範囲内で一意の値を調べるために、いくつかの洞察

Sub RemoveNonDupes() 
Selection.Copy 
Range("B2").Select 
ActiveSheet.Paste 
Application.CutCopyMode = False 
Range("B2:B5000").AdvancedFilter Action:= xlFilterInPlace, CriteriaRange:= Range("B2"), Unique := True 
Range("B2:B5000").SpecialCells(xlCellTypeVisible).EntireRow.Delete 
ActiveSheet.showalldata 
End Sub 

Answer 1

最も直接的なルートではありませんが、BとCの間にマクロを挿入することができます。次に、その列に数式をダンプします。

=のCOUNTIFSような何か（B：B：B、B）あなたに、そしてあなたは、その値が1

で任意の行を削除ループにスクリプトを設定することができますどのように多くの時間レコードショーのカウントを与えます

Sub Duplicates() 

Columns("B:B").Insert Shift:=xlToRight ' inserts a column after b 

count = Sheet1.Range("B:B").Cells.SpecialCells(xlCellTypeConstants).count ' counts how many records you have 

crange = "C1:C" & count ' this defines the range your formula's go in if your data doesn't start in b1, change the c1 above to match the row your data starts 

Sheet1.Range(crange).Formula = "=countifs(B:B,B:B)" ' This applies the same forumla to the range 

ct=0 
ct2=0 'This section will go cell by cell and delete the entire row if the count value is 1 
Do While ct2 < Sheet1.Range("C:C").Cells.SpecialCells(xlCellTypeConstants).count 
    For ct = 0 To Sheet1.Range("C:C").Cells.SpecialCells(xlCellTypeConstants).count 
     If Sheet1.Range("C1").Offset(ct, 0).Value > 1 Then 
      Sheet1.Range("C1").Offset(ct, 0).EntireRow.Delete 
     End If 

    Next 
ct2 = ct2 + 1 

Loop 
Sheet1.Columns("B:B").EntireColumn.delete 
end sub 

コードのような

何かがきれいではないですが、それは仕事をする必要があります。

* *コメント

Sub Duplicates() 

Columns("C:C").Insert Shift:=xlToRight ' inserts a column after b 

count = Activesheet.Range("C:C").Cells.SpecialCells(xlCellTypeConstants).count ' counts how many records you have 

crange = "C1:C" & count ' this defines the range your formula's go in if your data doesn't start in b1, change the c1 above to match the row your data starts 

Activesheet.Range(crange).Formula = "=countifs(B:B,B:B)" ' This applies the same forumla to the range 


ct=0 
ct2=0 'This section will go cell by cell and delete the entire row if the count value is 1 
''''' 
Do While ct2 < Activesheet.Range("C:C").Cells.SpecialCells(xlCellTypeConstants).count 
    For ct = 0 To Activesheet.Range("C:C").Cells.SpecialCells(xlCellTypeConstants).count 
     If Activesheet.Range("C1").Offset(ct, 0).Value = 1 Then 
      Activesheet.Range("C1").Offset(ct, 0).EntireRow.Delete 
     End If 

    Next 
ct2 = ct2 + 1 

Loop 
ActiveSheet.Columns("C:C").EntireColumn.delete 
end sub 

ごとに更新コードあなたはdoループは、各列を削除します何であると更新されたコード、一部には、私はカウントがある任意の行を削除するためにそれを固定することを試すことができます1.
私が理解しているところでは、データは列Bにあり、数は列Cにあるはずです。一致するように数式を更新してください

Answer 2

クリスを探して、私は少し異なる方法でExcelのアドバンスト・コピー機能を利用することをお勧め：

Range("RangeWithDupes").AdvancedFilter Action:=xlFilterCopy, CopyToRange:=Range("TargetRange"), unique:=True 

操作は 'TargetRange'にある 'RangeWithDupes'の一意の値のリストを提供します。結果の範囲を使用して、さまざまな方法でソースデータを操作できます。お役に立てれば。