删除Excel 2003 vba列中的重复条目

Question

那么问题是，我有一个列，例如 Y 列中有很多条目，接近 40,000 个，并且每周都在增加。问题是我必须检查 Y 列中的重复项并删除整行。因此，Y 列应该只有唯一的条目。

假设我有 3,000 个条目，1 周后，我将拥有大约 3,500 个条目。现在我必须检查这些新添加的 500 个列值，而不是旧的 3,500 个列值 + 新的 3,500 个条目，并删除重复的行。旧的 3,000 条不应删除或更改。我找到了宏，但它们对整个列都有效。我想过滤新的 500 个值。

 Cells(2, "Q").Formula = "=COUNTIF(P$1:P1,P2)=0"   'I have used these formula 
 Range("Q2").Copy Destination:=Range("Q3:Q40109")  'it gives false for the duplicate values

我知道我们必须使用 countif 来处理重复条目。但我正在做的是应用公式，然后搜索错误条目，然后将其删除。我相信应用公式并发现错误然后删除它有点耗时。

Sub DeleteDups() 
Dim x               As Long 
Dim LastRow         As Long 
LastRow = Range("A65536").End(xlUp).Row 
For x = LastRow To 1 Step -1 
    If Application.WorksheetFunction.CountIf(Range("A1:A" & x), Range("A" & x).Text) > 1 Then 
        Range("A" & x).EntireRow.Delete 
    End If 
Next x   
End Sub 

这是我在谷歌上找到的，但我不知道错误在哪里。如果我设置，它会删除所有列

For x = LastRow To 1 Step -1 
For x = LastRow to step 3000 ' It is deleting all 500 columns but if it is -1 working fine

这些功能需要进行任何修改吗？或者建议我任何对我有帮助的好功能。检查整个列中选定列范围的重复值。我的意思是检查 500 个完整列值与 3500 个列条目值，并删除 500 个条目中的重复项

提前致谢

Answer 1

这应该是相当简单的。您需要在文件中的某个位置创建 1 个单元格，以便在删除所有重复项后每周写入 Y 列的单元格计数。

例如，假设您在第 1 周删除了重复项，则剩下的范围为 Y1:Y100。您的函数会将“100”放入文件中的某个位置以供引用。

下周，您的函数将开始从（带有参考号的单元格）+ 1 的重复项开始查找，因此 Y:101 到列末尾。删除重复项后，该函数将参考单元更改为新计数。

代码如下：

Sub RemoveNewDupes()

'Initialize for first time running this
If Len(Range("A1").Value) = 0 Then
    Range("A1").Value = Range("Y" & Rows.count).End(xlUp).row
End If

If Range("A1").Value = 1 Then Range("A1").Value = 0

'Goodbye dupes!
ActiveSheet.Range("Y" & Range("A1").Value + 1 & ":Y" & _
Range("Y" & Rows.count).End(xlUp).row).RemoveDuplicates Columns:=1, Header:=xlNo

'Re-initialize the count for next time
Range("A1").Value = Range("Y" & Rows.count).End(xlUp).row

End Sub

*抱歉，不知道为什么自动语法突出显示使此内容难以阅读

更新：

这是在 Excel 2003 中执行此操作的一种方法。技巧是向后循环该列，以便当您删除一行时，循环不会被破坏。我使用字典（我以过度使用字典而闻名），因为它可以让你轻松检查是否有误。

Sub RemoveNewDupes()

Dim lastRow As Long
Dim dict As Object
Set dict = CreateObject("scripting.dictionary")

If Len(Range("A1").Value) = 0 Then
    Range("A1").Value = 1
End If

lastRow = Range("Y" & Rows.count).End(xlUp).row

On Error Resume Next
For i = lastRow To Range("A1").Value Step -1
    If dict.exists(Range("Y" & i).Value) = True Then
        Range("Y" & i).EntireRow.Delete
    End If
    dict.Add Range("Y" & i).Value, 1
Next

Range("A1").Value = Range("Y" & Rows.count).End(xlUp).row

End Sub

Answer 2

Excel 如何知道条目是“新”的？ （例如，我们怎么知道我们只需要考虑最后 500 行）
实际上，如果您上周已经执行了该宏，则前 3,000 行不会有任何重复项，因此当前执行不会更改这些行。

您描述的代码应该几乎可以工作。如果我们保留它并稍微改变它：

Sub DeleteDups() 
Dim x               As Long 
Dim LastRow         As Long 
LastRow = Range("Q65536").End(xlUp).Row 
For x = LastRow To 1 Step -1
    'parse every cell from the bottom to the top (to still count duplicates)
    '  and check if duplicates thanks to the formula 
    If Range("Q" & x).Value Then Range("Q" & x).EntireRow.Delete 
Next x   
End Sub

---

[编辑]另一个（可能更快）解决方案：首先过滤值，然后删除可见行：

Sub DeleteDups() 
ActiveSheet.UsedRange.AutoFilter Field:=17, Criteria1:="True" 'filter column Q for True values
ActiveSheet.Cells.SpecialCells(xlCellTypeVisible).EntireRow.Delete
End Sub

抱歉，无法在这里测试最后一个解决方案。

Answer 3

这是一个想法：

Sub test
LastRow = Range("A65536").End(xlUp).Row
For i = LastRow To 1 Step -1
  If Not Range("a1:a" & whateverLastRowYouWantToUse ).Find(Range("a" & i).Value, , , , , xlPrevious) Is Nothing Then
    Rows(i).Delete
  End If
Next i
End Sub

它检查当前单元格上方的整个范围是否有单个重复项。如果找到，则删除当前行。

编辑我刚刚在你的例子中意识到，你说的是Y列，但在你的代码中你正在检查A。不确定这个例子是否只是一个假设，但想确保这不是原因对于奇怪的行为。

请注意，这是未经测试的！请在尝试此操作之前保存您的工作簿！