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

Delete duplicate entries in a column in excel 2003 vba

提问by niko

Well the question is, I have got a column, for example column Y has many entries in it, nearly 40,000 and It increases everyweek. The thing is I have to check for duplicates in Y column and delete the entire row. Thus, Y column should have only unique entries.

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

Suppose I have 3,000 entries and after 1 week, i'll have about 3,500 entries. Now I have to check these newly added 500 columnn values not the 3,500 with the old + the new i.e 3,500 entries and delete the duplicated row. The old 3,000 shouldn't be deleted or changed. I have found macros but they do the trick for the entire column. I would like to filter the new 500 values.

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

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

I know we have to use countiffor the duplicate entries. But what Iam doing is applying the formula and then search for false entries and then delete it. I belive applying formula and finding false and then deleting its little bit time consuming.

我知道我们必须使用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 

This is what I found on google but i dont know where the error is. It is deleting all the columns if i set

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

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

Any modifications need to be done for these function? or sugest me any good function that helps me. Check for the duplicate values of a selected column range from the entire column. I mean check 500 entires column values with the 3500 column entry values and delete the duplicates in 500 entries

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

Thanks in advance

提前致谢

回答by aevanko

This should be rather simple. You need to create 1 cell somewhere in your file that you will write the cell count for column Y each week after removing all dupes.

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

For example, say week1 you remove dupes and you are left with a range of Y1:Y100. Your function will put "100" somewhere in your file to reference.

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

Next week, your function will start looking from dupes from (cell with ref number) + 1, so Y:101 to end of column. After removing dupes, the function changes the ref cell to the new count.

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

Here is the code:

这是代码：

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

*sorry no idea why auto-syntax highlighting makes this hard to read

*抱歉不知道为什么自动语法高亮使这很难阅读

Update:

更新：

Here is a way to do it in Excel 2003. The trick is to loop backwards through the column so that the loop isn't destroyed when you delete a row. I use a dictionary (which I'm famous for over-using) since it allows you to check easily for dupes.

这是在 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

回答by JMax

How can Excel know that entries are "new"? (e.g. how can we know we only have to consider the 500 last rows)
Actually, if you already executed the macro last week, the first 3,000 rows won't have any duplicates so the current execution won't change these rows.

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

The code your described should nearly work. If we keep it and change it very slightly:

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

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

---

---

[EDIT] Another (probably faster) solution: filter first the values and then delete the visible rows:

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

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

Couldn't test this last solution right here, sorry.

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

回答by Justin Self

Here's an idea:

这是一个想法：

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

It checks the entire range above the current cell for a single duplicate. If found, it the current row is deleted.

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

EDITI just realized in your example, you said column Y, but in your code you are checking A. Not sure if the example was just a hypothetical, but wanted to make sure that wasn't the reason for the odd behavior.

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

Note, this is untested! Please save your workbook before trying this!

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