如何在两个excel表之间快速删除重复的vba [英] How do I delete duplicates between two excel sheets quickly vba

问题描述

我正在使用vba，我有两个表，一个名为不要调用，并在列A中有大约80万行的数据。我想使用此数据来检查第二页中的列I，名为Sheet1 。如果找到匹配，我希望它删除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 
 
设置wsA = Worksheets（不要调用）
设置wsB =工作表（Sheet1）
 
 Dim dict As Object 
设置dict = CreateObject（Scripting.Dictionary）
 
 Do While Not IsEmpty（wsA.Range（keyColA& intRowCounterA）.Value）
设置rngA = wsA.Range（keyColA& intRowCounterA）
 strValueA = rngA.Value 
如果不是dict.Exists（strValueA）然后
 dict.Add strValueA，1 
 End If 
 intRowCounterA = intRowCounterA + 1 
循环
 
 intRowCounterB = 1 
尽管不是IsEmpty（wsB.Range（keyColB& intRowCounterB）.Value）
设置rngB = wsB.Range（keyColB& intRowCounterB）
如果dict.Exists（rngB.Value）然后
 wsB.Rows（intRowCounterB）.delete 
 intRowCounterB = intRowCounterB  -  1 
 End If 
 intRowCounterB = intRowCounterB + 1 
 Loop 
 End Sub 
  

如果上述代码不在代码标签中，我们深表歉意。这是我第一次在线发布代码，我不知道我是否正确地执行。

解决方案

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

  Option Explicit 
 Sub CleanDupes（）
 Dim targetArray，searchArray 
 Dim targetRange As Range 
 Dim x As Long 
 
'如果您的目标和搜索范围更改
 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
 
'加载目标数组
带表格（TargetSheetName）
设置targetRange = .Range（.Range（TargetSheetColumn& 1），_ 
 .Range（TargetSheetCo lb& Rows.Count）.End（xlUp））
 targetArray = targetRange 
结束
'加载搜索数组
带表格（SearchSheetName）
 searchArray =。范围（.Range（SearchSheetColumn& 1），_ 
 .Range（SearchSheetColumn& Rows.Count）.End（xlUp））
结束
 
 
 Dim dict As Object 
 Set dict = CreateObject（Scripting.Dictionary）
'从搜索数组中填充字典
如果IsArray（searchArray）然后
对于x = 1到UBound（searchArray）
如果没有dict.exists（searchArray（x，1））Then 
 dict.Add searchArray（x，1），1 
 End If 
 Next 
 Else 
如果不是dict.exists（searchArray）然后
 dict.Add searchArray，1 
如果
结束If 
 
'删除在字典中找到的值
如果IsArray（targetArray）然后
'向后退避以避免删除错误的行。 
对于x = UBound（targetArray）到1步-1 
如果dict.exists（targetArray（x，1））然后
 targetRange.Cells（x）.EntireRow.Delete 
如果
下一个
 Else 
如果dict.exists（targetArray）然后
 targetRange.EntireRow.Delete 
 End If 
 End If 
 End Sub 
  

编辑：因为它困扰着我，我重读了你提供的代码。它让我感到困惑，因为它不是按照我预期的方式编写的，除非你只检查字符串值。我已经添加了评论来指出这个代码片段的作用：

 '检查特定单元格是否为空。 
 Do Is Not IsEmpty（wsA.Range（keyColA& intRowCounterA）.Value）
'将单元格存储到一个范围，没有很好的理由。 
设置rngA = wsA.Range（keyColA& intRowCounterA）
'将单元格的值转换为字符串，因为strValueA是一个字符串。 
 strValueA = rngA.Value 
'检查字符串是否在字典中。 
如果不是dict.Exists（strValueA）然后
'将字符串添加到字典。 
 dict.Add strValueA，1 
如果
  

然后稍后： p>

 '检查值，而不是将值转换为字符串。 
如果dict.Exists（rngB.Value）然后
  

这会失败，因为脚本字典不要考虑一个双重等于一个字符串，即使它们是相同的，如果双被转换为一个字符串。

两种方法来修复你发布的代码，更改我刚刚显示的行：

 如果dict.Exists（cstr（rngB.Value））然后
  

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

I am using vba and I have two sheets one is named "Do Not Call" and has about 800,000 rows of data in column A. I want to use this data to check column I in the second sheet, named "Sheet1". If it finds a match I want it to delete the whole row in "Sheet1". I have tailored the code I have found from a similar question here: Excel formula to Cross reference 2 sheets, remove duplicates from one sheet and ran it but nothing happens. I am not getting any errors but it is not functioning.

Here is the code I am currently trying and have no idea why it is not working

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

I apologize if the above code is not in a code tag. This is my first time posting code online and I have no idea if I did it correctly.

解决方案

I'm embarrassed to admit that the code you shared confused me... anyway for the practice I rewrote it using arrays instead of looping through the sheet values:

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

Edit: Because it bothered me, I reread the code that you provided. It confuses me because it isn't written the way I'd have expected and fails unless you're checking string values only. I've added comments to indicate what it's doing in this snippet:

'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

Then later:

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

This fails because the Scripting Dictionary does not consider a double to equal a string, even if they would be the same if the double were converted to a string.

Two ways to fix the code you posted, either change the line I just showed to this:

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

Or you can change Dim strValueA As String to Dim strValueA.

这篇关于如何在两个excel表之间快速删除重复的vba的文章就介绍到这了，希望我们推荐的答案对大家有所帮助，也希望大家多多支持IT屋！