Excel宏。根据列删除非重复行

Question

尝试在Excel中运行宏以删除非重复项，以便轻松检查。

步骤通过在“B”列的每个小区，开始于B2（B1是报头）

在运行中，如果当前的小区B具有在列B中的任何地方的匹配 - 离开它，如果它是唯一的 - 除去整行

下面的代码执行的结果不一致。

寻找一些见解

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'的唯一值列表。然后，您可以使用结果范围以多种方式操作源数据。希望这可以帮助。