在Excel 2003中刪除列中的重複條目vba

Question

那麼問題是，我有一個列，例如列Y有很多條目，近40,000，它增加了每週。問題是我必須檢查Y列中的重複項並刪除整行。因此，Y列應該只有唯一的條目。

假設我有3,000個參賽作品，並且在1周之後，我將有大約3,500個參賽作品。現在，我必須檢查這些新添加的500列值，而不是舊的+新的3500例項目，並刪除重複的行。舊3000不應該刪除或更改。我發現了宏，但他們爲整個列做了訣竅。我想篩選新的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個entires列值與3500點項的值並刪除重複項500項

在此先感謝

Answer 1

這應該是相當簡單的。您需要在文件的某個位置創建1個單元，您將在刪除所有模糊後每週爲Y列編寫單元格計數。

例如，假設week1您刪除了dupes，並且您剩下的範圍爲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

這裏有一個想法：

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.不知道的例子只是一個假設，但希望確保這不是對的原因奇怪的行爲。

請注意，這是未經測試的！請在嘗試此操作之前保存您的工作簿！

Answer 3

Excel如何知道條目是「新」？ （例如，我們怎麼知道我們只需要考慮最後500行）
實際上，如果您上週已經執行了宏，前3000行將不會有任何重複項，因此當前執行不會更改這些行。

您描述的代碼幾乎可以工作。如果我們保持它，改變它非常輕微：

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 

Couldn」不要在這裏測試最後的解決方案。