VBA子需要很长时间才能执行

问题描述

我在sheet1中有3000行数据，我需要将此数据与sheet2进行比较。在开始比较之前，我要找到工作表2中没有的员工。如果在工作表2中找不到该员工，我要删除工作表1中的记录并向上移动单元格。 删除未找到的员工记录并向上移动单元格需要很长时间。我将屏幕更新= false和计算模式设置为xlmanual。仍然需要很长时间。

如何加快此代码的执行速度。下面是示例代码：

For Each rngCell In Sheets("Sheet1").Range("AE3:AE" & lastRow)
    If WorksheetFunction.CountIf(Sheets("Sheet2").Range("V2:V" & lastRow),rngCell) = 0 Then
        Sheets("Sheet3").Range("A" & Rows.Count).End(xlUp).Offset(1) = rngCell                        
        Sheets("Sheet1").Range("AE" & rngCell.Row & ":" & "AR" & rngCell.Row).Delete Shift:=xlUp
        
    End If
Next

解决方法

您的代码运行缓慢主要有以下三个原因：

1. 它从单个单元格进行多次读取。这很慢
2. 它对单个单元格执行许多写入操作。这甚至更慢。
3. 它对单个行中的几个单元格进行了多次删除。这甚至还慢。

我对提高速度的建议：

1. 在循环之前一次将要处理的数据读入Variant Arrays

2. 环绕数组而不是范围

3. 在循环时构建新的数据数组。在循环结束时，将数组一次放置到一张纸上。

4. 为要在循环时删除的单元格建立范围引用（即，不要在循环中删除）。循环后一键删除已建立的Range。

SO上每种技术都有很多示例

为其他可能想要扩展此范围的读者的注意事项：

使用Union构建一系列不连续的子范围不能很好地扩展。随着范围内非连续子范围的数量增加，使用并集添加另一个范围所花费的时间呈指数增加。最多约1000个子范围将不会引起注意。一旦达到千分之十或十万分之一，减速就很明显

,

在迭代过程中删除绝对不是一个好主意。如果必须删除，最好从底部删除。

您可以使用下面的示例代码从最后一行迭代到第一行。

x86_64-posix-seh

,

此参考：

Sheets("Sheet2").Range("V2:V" & lastRow)

不会在整个循环中更改它的值，但是您需要在每次迭代时重新计算它。

将其存储在循环外的变量中：

Dim sheet2Vlastrow As Range
Set sheet2Vlastrow = Sheets("Sheet2").Range("V2:V" & lastRow)

For Each rngCell In Sheets("Sheet1").Range("AE3:AE" & lastRow)
    If WorksheetFunction.CountIf(sheet2Vlastrow,rngCell) = 0 Then
        Sheets("Sheet3").Range("A" & Rows.Count).End(xlUp).Offset(1) = rngCell                        
        Sheets("Sheet1").Range("AE" & rngCell.Row & ":" & "AR" & rngCell.Row).Delete Shift:=xlUp            
    End If
Next

,

在需要删除的行上，而是添加带有公式的列，以确定另一张纸上是否存在某些ID（例如VLOOKUP或COUNTIF）。然后，您可以将未找到的行过滤掉，或者如果必须删除，请使用vba将其排序到最底部，然后过滤再删除。