如何快速vba删除两个excel表单之间的重复

我使用的是vba，而且我有两张表，一个名为“Do Not Call”，在A列中有大约800,000行数据。我想用这个数据来检查第二张表中的第一列“Sheet1”。 如果find一个匹配，我希望它删除“Sheet1”中的整个行。 我已经量身定制了我从类似的问题在这里find的代码： Excel公式交叉引用2张，从一张纸删除重复并运行它，但没有任何反应。 我没有得到任何错误，但它不起作用。

这是我目前正在尝试的代码，不知道为什么它不工作

Option Explicit Sub CleanDupes() Dim wsA As Worksheet Dim wsB As Worksheet Dim keyColA As String Dim keyColB As String Dim rngA As Range Dim rngB As Range Dim intRowCounterA As Integer Dim intRowCounterB As Integer Dim strValueA As String keyColA = "A" keyColB = "I" intRowCounterA = 1 intRowCounterB = 1 Set wsA = Worksheets("Do Not Call") Set wsB = Worksheets("Sheet1") Dim dict As Object Set dict = CreateObject("Scripting.Dictionary") Do While Not IsEmpty(wsA.Range(keyColA & intRowCounterA).Value) Set rngA = wsA.Range(keyColA & intRowCounterA) strValueA = rngA.Value If Not dict.Exists(strValueA) Then dict.Add strValueA, 1 End If intRowCounterA = intRowCounterA + 1 Loop intRowCounterB = 1 Do While Not IsEmpty(wsB.Range(keyColB & intRowCounterB).Value) Set rngB = wsB.Range(keyColB & intRowCounterB) If dict.Exists(rngB.Value) Then wsB.Rows(intRowCounterB).delete intRowCounterB = intRowCounterB - 1 End If intRowCounterB = intRowCounterB + 1 Loop End Sub 

如果上面的代码不在代码标签中，我表示歉意。 这是我第一次在网上发布代码，我不知道我是否做得正确。

Answer 1

我很尴尬地承认，你分享的代码使我感到困惑…无论如何，我用数组重写了它，而不是循环遍历表的值：

 Option Explicit Sub CleanDupes() Dim targetArray, searchArray Dim targetRange As Range Dim x As Long 'Update these 4 lines if your target and search ranges change Dim TargetSheetName As String: TargetSheetName = "Sheet1" Dim TargetSheetColumn As String: TargetSheetColumn = "I" Dim SearchSheetName As String: SearchSheetName = "Do Not Call" Dim SearchSheetColumn As String: SearchSheetColumn = "A" 'Load target array With Sheets(TargetSheetName) Set targetRange = .Range(.Range(TargetSheetColumn & "1"), _ .Range(TargetSheetColumn & Rows.Count).End(xlUp)) targetArray = targetRange End With 'Load Search Array With Sheets(SearchSheetName) searchArray = .Range(.Range(SearchSheetColumn & "1"), _ .Range(SearchSheetColumn & Rows.Count).End(xlUp)) End With Dim dict As Object Set dict = CreateObject("Scripting.Dictionary") 'Populate dictionary from search array If IsArray(searchArray) Then For x = 1 To UBound(searchArray) If Not dict.exists(searchArray(x, 1)) Then dict.Add searchArray(x, 1), 1 End If Next Else If Not dict.exists(searchArray) Then dict.Add searchArray, 1 End If End If 'Delete rows with values found in dictionary If IsArray(targetArray) Then 'Step backwards to avoid deleting the wrong rows. For x = UBound(targetArray) To 1 Step -1 If dict.exists(targetArray(x, 1)) Then targetRange.Cells(x).EntireRow.Delete End If Next Else If dict.exists(targetArray) Then targetRange.EntireRow.Delete End If End If End Sub 

编辑：因为它困扰我，我重读你提供的代码。 它使我感到困惑，因为它不是按照我所期望的方式写的，除非你仅仅检查string值，否则就会失败。 我已经添加了一些评论来说明这个代码片段在做什么：

 'Checks to see if the particular cell is empty. Do While Not IsEmpty(wsA.Range(keyColA & intRowCounterA).Value) 'Stores the cell to a range for no good reason. Set rngA = wsA.Range(keyColA & intRowCounterA) 'Converts the value of the cell to a string because strValueA is a string. strValueA = rngA.Value 'Checks to see if the string is in the dictionary. If Not dict.Exists(strValueA) Then 'Adds the string to the dictionary. dict.Add strValueA, 1 End If 

后来：

  'checks the value, not the value converted to a string. If dict.Exists(rngB.Value) Then 

这个失败是因为Scripting Dictionary没有考虑一个double来等于一个string，即使这个double被转换为一个string，它们也是一样的。

有两种方法可以修复您发布的代码，或者更改我刚刚展示的代码：

 If dict.Exists(cstr(rngB.Value)) Then 

或者，您可以将Dim strValueA As String更改为Dim strValueA 。

Answer 2

因为我有时间，这里是一个重写放弃词典，而是使用工作表函数。 （受Vlookup评论的启发）。 我不确定哪一个会更快。

 Sub CleanDupes() Dim targetRange As Range, searchRange As Range Dim targetArray Dim x As Long 'Update these 4 lines if your target and search ranges change Dim TargetSheetName As String: TargetSheetName = "Sheet1" Dim TargetSheetColumn As String: TargetSheetColumn = "I" Dim SearchSheetName As String: SearchSheetName = "Do Not Call" Dim SearchSheetColumn As String: SearchSheetColumn = "A" 'Load target array With Sheets(TargetSheetName) Set targetRange = .Range(.Range(TargetSheetColumn & "1"), _ .Range(TargetSheetColumn & Rows.Count).End(xlUp)) targetArray = targetRange End With 'Get Search Range With Sheets(SearchSheetName) Set searchRange = .Range(.Range(SearchSheetColumn & "1"), _ .Range(SearchSheetColumn & Rows.Count).End(xlUp)) End With If IsArray(targetArray) Then For x = UBound(targetArray) To 1 Step -1 If Application.WorksheetFunction.CountIf(searchRange, _ targetArray(x, 1)) Then targetRange.Cells(x).EntireRow.Delete End If Next Else If Application.WorksheetFunction.CountIf(searchRange, targetArray) Then targetRange.EntireRow.Delete End If End If End Sub