重复使用vba中的数组删除
您好使用一些代码从一个问题的答案'如何快速vba删除两个excel工作表之间的重复'，并试图改变这个代码来套用我自己的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 任何人都可以帮助我，这将是非常appreicated，我没有改变正确的脚本，或者是缺less的东西？
在这个网站上似乎已经变得几乎获得了智慧，删除行的任务最好通过从下到上循环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毫秒
范围：15.2153416146466毫秒
这些结果并不令人惊讶，因为它可能是公平的，一个Worksheet的个人交互的数量越多，程序越慢。
有一件令人遗憾的事情是，删除重复内容的一些post花费了大量篇幅来读取Worksheet值并将其引用到数组中，以避免过多的表单交互。 然而，所有这些效率提升都是由于低效的行删除而丢失的。 误导的是这些post有时候是“快”的。
有些人可能会争辩说，他们希望在行删除之间的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
所以下面的代码仍然会删除单元格“A4”和“A6”以及原始单元格“A8”和“A10”，例如：
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表格之间的重复项”？ 用下面的代码：
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中的variables在angular色代码中的作用和function，也有一些误解，其他的被调查者已经指出了这一点。 但是，为了完整性，他/她的两个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
这看起来：
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
我不认为这是你的意图，应该抛出一个错误。