2

我正在使用 vba，我有两张名为“Do Not Call”的工作表，在 A 列中有大约 800,000 行数据。我想使用这些数据检查第二张工作表中名为“Sheet1”的 I 列。如果它找到匹配项，我希望它删除“Sheet1”中的整行。我已经定制了从类似问题中找到的代码：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

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

4

2 回答 2

4

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

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

编辑：因为它困扰我，我重新阅读了您提供的代码。它让我感到困惑，因为它没有按照我预期的方式编写并且失败，除非您只检查字符串值。我添加了注释来说明它在这个片段中所做的事情：

'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

这失败了，因为脚本字典不认为双精度等于字符串，即使双精度转换为字符串时它们是相同的。

修复您发布的代码的两种方法，或者将我刚刚显示的行更改为：

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

或者您可以更改Dim strValueA As String为Dim strValueA.

于 2012-12-02T01:55:30.230 回答
0

因为我有时间，所以这里重写了字典，而是使用了工作表函数。（受 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
于 2012-12-02T05:00:00.590 回答