Question

我正在使用vba，我有两张表，其中一张名为“Do Not Call”，在A栏中有大约800,000行数据。我想用这些数据检查第二张表中的第一列，名为“Sheet1” 。如果找到匹配项，我希望它删除“Sheet1”中的整行。我已经从这里的类似问题中定制了我找到的代码：Excel formula to Cross reference 2 sheets, remove duplicates from one sheet然后运行它但没有任何反应。我没有收到任何错误，但它没有运作。

以下是我目前正在尝试的代码，并且不知道它为什么不起作用

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

因为我有时间，所以这里是重写字典而不是使用工作表函数。（受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

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

1 个答案: