Question

您已经使用了问题'How do I delete duplicates between two excel sheets quickly vba'的答案中的一些代码，并尝试更改此代码以适应我自己的VBA脚本。代码确实删除了与数组中的内容相同数量的行，但它只是删除了前11行。我是VBA的新手，并不完全理解为什么这样做。下面是我正在使用的脚本的副本。

    Dim overLayWB As Workbook       'Overlay_workbook
    Dim formattedWB As Workbook     'Formatted_workbook
    Dim formattedWS As Worksheet    'Current active worksheet (Formatted)
    Dim overLayWS As Worksheet      'Worksheet in OverLay
    Dim lastRowFormatted As Long
    Dim lastRowOverLay As Long

    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 = "Formatted"
    Dim TargetSheetColumn As String: TargetSheetColumn = "G22"
    Dim SearchSheetName As String: SearchSheetName = "Overlay"
    Dim SearchSheetColumn As String: SearchSheetColumn = "G22"



    'open Overlay workbook
    Set overLayWB = Workbooks.Open("C:\Documents\Templates\Overlaye.xls") 'Path for workbook Overlay to copy from
    Set formattedWS = Workbooks("Formatted").Sheets("DLT Formatted")
    Set overLayWS = Workbooks("Overlay").Sheets("Overlay")
    Set formattedWB = ThisWorkbook

 'Load target array
    With formattedWS
        Set targetRange = .Range(.Range(TargetSheetColumn & "7"), _
                .Range(TargetSheetColumn & Rows.Count).End(xlUp))
        targetArray = targetRange
    End With

 'Load Search Array
    With overLayWS
        searchArray = .Range(.Range(SearchSheetColumn & "7"), _
                .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

任何人都可以帮我解决这个问题吗？我没有正确改变脚本，或者它缺少什么东西？

Answer 1

在这个网站上似乎已经几乎获得了智慧，删除行的任务最好通过从底部到顶部循环Range并在符合条件时删除每一行来实现。然而，这确实是一种非常低效的方法。比较这两个片段，例如：

Dim r As Long
Dim clock As cTimer

Set clock = New cTimer

clock.StartCounter
Application.ScreenUpdating = False
For r = 1 To 10000
    Sheet1.Cells(1, 1).EntireRow.Delete
Next
Application.ScreenUpdating = True
Debug.Print "Row by row:"; clock.TimeElapsed; "ms"

clock.StartCounter
Application.ScreenUpdating = False
Sheet1.Range("A1:A10000").EntireRow.Delete
Application.ScreenUpdating = True
Debug.Print "Range:"; clock.TimeElapsed; "ms"

输出如下：

逐行：2876.18174935641 ms

范围：15.2153416146466 ms

这些结果并不令人惊讶，因为可能一般地认为与Worksheet的个人互动次数越多，该计划的速度就越慢。

遗憾的是，删除重复项的一些帖子会花费大量时间来读取Worksheet值并将项目引用到数组中以避免过多的工作表交互。然而，所有这些效率增益都因低效的行删除而丢失。误导的是，这些帖子有时声称是＆＃34;快速＆＃34;。

有些人可能会争辩说，他们希望在行删除之间执行Worksheet上的任务。但是，VBA范围以与Excel公式范围相同的方式更新其地址。请查看下面的代码，以获取此示例：

Dim cell As Range

Set cell = Sheet1.Range("A3")
Debug.Print "Address before deletion:"; cell.Address
Sheet1.Range("A1").EntireRow.Delete
Debug.Print "Address after deletion:"; cell.Address

输出是：

删除前的地址：$ A $ 3

删除后的地址：$ A $ 2

所以下面的代码仍会删除单元格＆＃34; A4＆＃34;和＆＃34; A6＆＃34;和原始细胞＆＃34; A8＆＃34;和＆＃34; A10＆＃34;，例如：

Dim rng1 As Range
Dim rng2 As Range

Set rng1 = Sheet1.Range("A4, A6")
Set rng2 = Sheet1.Range("A8, A10")
rng1.EntireRow.Delete
Sheet1.Range("A5").Insert xlDown
rng2.EntireRow.Delete

对于实际应用，OP可以真正回答以下问题：如何快速删除两张excel表之间的重复内容vba＆＃39;？使用以下代码：

Private Sub RemoveMatchingRowsAsBatch(refRange As Range, targetRange As Range)
    Dim refValues As Variant
    Dim refItems As Collection
    Dim refIndex As Long
    Dim refKey As String
    Dim targetValues As Variant
    Dim targetIndex As Long
    Dim targetKey As String
    Dim test As Variant
    Dim delRows As Range
    Dim added As Boolean

    'Read datasets into arrays
    refValues = refRange.Value2
    targetValues = targetRange.Value2

    'Loop through target values and check if items match
    Set refItems = New Collection
    For targetIndex = 1 To UBound(targetValues, 1)
        If Not IsEmpty(targetValues(targetIndex, 1)) Then
            targetKey = CStr(targetValues(targetIndex, 1))
            test = Empty: On Error Resume Next
            test = refItems(targetKey): On Error GoTo 0

            'Check if existing ref item list has a match
            If Not IsEmpty(test) Then
                targetRange.Cells(targetIndex, 1).EntireRow.Delete
                If delRows Is Nothing Then
                    Set delRows = targetRange.Cells(targetIndex, 1)
                Else
                    Set delRows = Union(delRows, targetRange.Cells(targetIndex, 1))
                End If
            Else
                'There is no match so continue reading the reference list.
                Do While refIndex < UBound(refValues, 1)
                    refIndex = refIndex + 1
                    If Not IsEmpty(refValues(refIndex, 1)) Then
                        'Test that the new reference item isn't itself a duplicate.
                        refKey = CStr(refValues(refIndex, 1))
                        On Error Resume Next
                        refItems.Add refKey, refKey
                        added = Err.Number = 0
                        On Error GoTo 0
                        'It isn't a duplicate so check for a match.
                        If added Then
                            If refKey = targetKey Then
                                If delRows Is Nothing Then
                                    Set delRows = targetRange.Cells(targetIndex, 1)
                                Else
                                    Set delRows = Union(delRows, targetRange.Cells(targetIndex, 1))
                                End If
                                Exit Do
                            End If
                        End If
                    End If
                Loop


            End If
        End If
    Next

    'Now delete all rows in one 'batch'.
    If Not delRows Is Nothing Then
        delRows.EntireRow.Delete
    End If

End Sub

实际上，对于变量在OP代码中的作用和功能也存在一些误解，而其他受访者已经指出了这些误解。但是，为了完整性，他/她的两个Worksheets的正确阅读程序可能如下所示：

Public Sub ReadSheets()
    Dim refFilePath As String
    Dim refBookName As String
    Dim refBook As Workbook
    Dim refSheet As Worksheet
    Dim refSheetName As String
    Dim refCol As String
    Dim refRow As Long
    Dim refRange As Range
    Dim refValues As Variant
    Dim targetBook As Workbook
    Dim targetSheet As Worksheet
    Dim targetSheetName As String
    Dim targetCol As String
    Dim targetRow As Long
    Dim targetRange As Range
    Dim targetValues As Variant

    'Define your sheet variables.
    refFilePath = "Z:\ambie\VBA"
    refBookName = "reference.xlsx"
    refSheetName = "data"
    refCol = "A"
    refRow = "2"
    targetSheetName = "uniques"
    targetCol = "B"
    targetRow = "3"

    'Define the Excel the sheet objects.
    On Error Resume Next
    Set refBook = Workbooks(refBookName)
    On Error GoTo 0
    If refBook Is Nothing Then
        Set refBook = Workbooks.Open(refFilePath & "\" & refBookName)
    End If
    Set refSheet = refBook.Worksheets(refSheetName)
    Set targetBook = ThisWorkbook
    Set targetSheet = targetBook.Worksheets(targetSheetName)

    'Read both datasets.
    With refSheet
        Set refRange = .Range(.Cells(refRow, refCol), _
                              .Cells(.Rows.Count, refCol).End(xlUp))
    End With

    With targetSheet
        Set targetRange = .Range(.Cells(targetRow, targetCol), _
                                 .Cells(.Rows.Count, targetCol).End(xlUp))
    End With

    'Call the removal routine here
    RemoveMatchingRowsAsBatch refRange, targetRange
End Sub

Answer 2

这看起来：

With formattedWS
    Set targetRange = .Range(.Range(TargetSheetColumn & "7"), _
            .Range(TargetSheetColumn & Rows.Count).End(xlUp))
    targetArray = targetRange
End With

使用您提供的值转换为：

With formattedWS
    Set targetRange = .Range(.Range("G227"), _
            .Range("G221048576").End(xlUp))
    targetArray = targetRange
End With

我不认为这是你的意图，应该抛出错误。

使用vba

2 个答案: