删除excel 2003 vba中列中的重复条目 [英] Delete duplicate entries in a column in excel 2003 vba

问题描述

问题是，我有一个专栏，例如Y列有很多条目，近4万个，每周增加一个。我必须检查Y列中的重复项，并删除整行。因此，Y列应该只有唯一的条目。

假设我有3,000个条目，1周后，我将有大约3,500个条目。现在我必须使用旧的+新的3,500条目检查这些新添加的500列数值，而不是3,500，并删除重复的行。旧的3000不应该被删除或更改。我已经找到了宏，但是他们对整个列做了一些技巧。我想过滤新的500个值。

 单元格（2，Q）。Formula == COUNTIF $ 1：P1，P2）= 0'我已经使用这些公式
范围（Q2）。复制目的地：=范围（Q3：Q40109）'它为重复值虚假
  

我知道我们必须对重复的条目使用 countif 但是，Iam做的是应用公式，然后搜索虚假条目，然后删除它。我相信应用公式并发现错误，然后删除它的一点点耗时。

  Sub DeleteDups（）
 Dim x As Long 
 Dim LastRow As Long 
 LastRow = Range（A65536）。End（xlUp）.Row 
对于x = LastRow到1 Step -1 
如果Application.WorksheetFunction .CountIf（Range（A1：A& x），Range（A& x）.Text）> 1然后
范围（A& x）.EntireRow.Delete 
结束如果
下一个x 
 End Sub 
  pre> 
 
 
这是我在google上找到的，但我不知道错误在哪里。如果我设置了
，则删除所有列。
 
 
 对于x = LastRow到1 Step -1 
对于x = LastRow到3000步'删除所有500列，但如果它是-1工作罚款
  
任何修改需要要做这些功能？或者给我任何有助于我的好功能。从整个列中检查所选列范围的重复值。我的意思是检查500具有3500列条目值的列值，并删除500个条目中的重复项
 
 
 
提前感谢
解决方案
这应该是相当简单的。您需要在文件中的某个地方创建1个单元格，您将在删除所有的复制件后每周写入Y列的单元格数。
 
 
 
例如，说week1你删除重复并且你留下的范围是Y1：Y100。您的功能将在您的文件中的某个位置引用100。
 
 
 
下周，您的功能将从（小号与ref号）+ 1的重复开始查找，因此Y：101到列的末尾。删除重复后，该函数会将引用单元更改为新的计数。
 
 
 
这是代码：
  Sub RemoveNewDupes（）
 
'首次初始化运行此
如果Len（范围（A1）。值）= 0然后
 Range（A1）。Value = Range（Y& Rows.count）.End（xlUp）.row 
 End If 
 
如果Range（A1）。 Value = 1 Then Range（A1）。Value = 0 
 
'再见！ 
 ActiveSheet.Range（Y& Range（A1）。值+ 1&：Y& _ 
范围（Y& Rows.count）.End xlUp）.row）.RemoveDuplicates列：= 1，标题：= xlNo 
 
'下次重新初始化计数
范围（A1）。值=范围（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）
 
如果Len（范围（A1）。值）= 0然后
范围（A1）。Value = 1 
 End If 
 
 lastRow = Range（Y& Rows计数）.End（xlUp）.row 
 
 On Error Resume Next 
 For i = lastRow To Range（A1）。Value Step -1 
如果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 
  
 
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.

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.
 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
I know we have to use countif for 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.
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

Thanks in advance
解决方案
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.

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.

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.

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.
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


                        
这篇关于删除excel 2003 vba中列中的重复条目的文章就介绍到这了，希望我们推荐的答案对大家有所帮助，也希望大家多多支持IT屋！