在Excel中删除列中的重复数据

我有这个代码的问题：

Sub text() Dim iListCount As Integer Dim x As Variant Dim iCtr As Integer ' Turn off screen updating to speed up macro. Application.ScreenUpdating = False ' Get count of records to search through (list that will be deleted). iListCount = Sheets("sheet2").Cells(Rows.Count, "C").End(xlUp).Row ' Loop through the "master" list. For Each x In Sheets("Sheet2").Range("A1:A" & Sheets("Sheet2").Cells(Rows.Count, "C").End(xlUp).Row) ' Loop through all records in the second list. For iCtr = iListCount To 1 Step -1 ' Do comparison of next record. ' To specify a different column, change 1 to the column number. If x.Value = Sheets("Sheet2").Cells(iCtr, 3).Value Then ' If match is true then delete row. Sheets("Sheet2").Cells(iCtr, 1).EntireRow.Delete End If Next iCtr Next Application.ScreenUpdating = True MsgBox "Done!" End Sub 

它运行，和一些作品。 它删除一个重复，但留下所有其他人。 我testing这个，所以我使用一个小样本大小，所以我知道有5个重复，但是我不能得到这个代码来删除它们。 有任何想法吗？ 我认为它是一个循环的问题，但无论我改变什么，我都无法得到它的工作

Answer 1

通过删除内部循环中的整行，您正在修改外部循环在循环中间循环的范围。 这样的代码很难debugging。

你的嵌套循环结构本质上是一系列线性search。 这使整个行为在行数上是二次的，并且可以减慢应用程序的爬行速度。 一种方法是使用可以在VBA中使用的dictionary ，如果您的项目包含对Microsoft Scripting Runtime的引用（VBA编辑器中的工具 – 引用）

下面的子使用一个字典来删除列C中具有A列中出现的值的所有单元格：

 Sub text() Dim MasterList As New Dictionary Dim iListCount As Integer Dim x As Variant Dim iCtr As Integer Dim v As Variant Application.ScreenUpdating = False ' Get count of records in master list iListCount = Sheets("sheet2").Cells(Rows.Count, "A").End(xlUp).Row 'Load Dictionary: For iCtr = 1 To iListCount v = Sheets("sheet2").Cells(iCtr, "A").Value If Not MasterList.Exists(v) Then MasterList.Add v, "" Next iCtr 'Get count of records in list to be deleted iListCount = Sheets("sheet2").Cells(Rows.Count, "C").End(xlUp).Row ' Loop through the "delete" list. For iCtr = iListCount To 1 Step -1 If MasterList.Exists(Sheets("Sheet2").Cells(iCtr, "C").Value) Then Sheets("Sheet2").Cells(iCtr, "C").Delete shift:=xlUp End If Next iCtr Application.ScreenUpdating = True MsgBox "Done!" End Sub 

Answer 2

另一个select是循环遍历单元格，使用Find和FindNextfind重复项，并使用Union（）将它们添加到范围中。 您可以在程序结束时删除该范围。 这就解决了在遍历它们时删除行的问题，并且应该很快执行。

注意：这段代码没有经过testing，您可能需要debugging它。

 Sub text() Dim cell As Range Dim lastCell as Range Dim masterList as Range Dim matchCell as Range Dim removeUnion as Range Dim firstMatch as String ' Turn off screen updating to speed up macro. Application.ScreenUpdating = False With Sheets("sheet2").Range("A:A") ' Find the last cell with data in column A Set lastCell = .Find("*", .Cells(1,1), xlFormulas, xlPart, xlByRows, xlPrevious) ' Set the master list range to the used cells within column A Set masterList = .Range(.cells(1,1) , lastCell) End With ' Loop through the "master" list. For Each cell In masterList ' Look for a match anywhere within column "C" With cell.Parent.Range("C:C") Set matchCell = .Find(.Cells(1,1), cell.Value, xlValues, xlWhole, xlByRows) 'If we got a match, add it to the range to be deleted later and look for more matches If Not matchCell is Nothing then 'Store the address of first match so we know when we are done looping firstMatch = matchCell.Address 'Look for all duplicates, add them to a range to be deleted at the end Do If removeUnion is Nothing Then Set removeUnion = MatchCell Else Set removeUnion = Application.Union(removeUnion, MatchCell) End If Set MatchCell = .FindNext Loop While (Not matchCell Is Nothing) and matchCell.Address <> firstMatch End If 'Reset the variables used in find before next loop firstMatch = "" Set matchCell = Nothing End With Next If Not removeUnion is Nothing then removeUnion.EntireRow.Delete Application.ScreenUpdating = True MsgBox "Done!" End Sub