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

Chris，为了检查给定数据范围内的唯一值，我建议以稍微不同的方式使用Excel的高级复制功能：

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

该操作将为您提供来自＆＃39; RangeWithDupes＆＃39;的唯一值列表。位于＆＃39; TargetRange＆＃39;。然后，您可以使用结果范围以多种方式操作源数据。希望这会有所帮助。

Excel宏。基于列删除非重复行

2 个答案: