excel - 循环遍历 ListObject 中的行来删除它们非常慢

Question

我有一个包含约 500 行的 ListObject 表，在命名范围内还有 4 个值。

对于 500 行，可能有 30 个重复(随机)出现的唯一值，我想删除其值不在指定范围内的所有行。

我有以下工作，但它的运行速度比预期慢(大约 2 分钟):

Sub removeAccounts()

Dim tbl As ListObject
Dim i As Integer

Set tbl = ThisWorkbook.Sheets("TheSheet").ListObjects("TheTable")

i = tbl.ListRows.Count


While i > 0
  If Application.WorksheetFunction.CountIf(Range("Included_Rows"), tbl.ListRows(i).Range.Cells(1).Value) = 0 Then
    tbl.ListRows(i).Delete
  End If
  i = i - 1
Wend

End Sub

我不确定是否是对工作表功能的依赖，或者只是循环遍历行使其速度减慢。

有没有办法过滤列表对象并丢弃其余的？

我想在上面放一个进度条，以便用户可以看到正在发生的事情......

Answer 1

试试这个代码:

Sub removeAccounts()

 Dim tbl As ListObject
 Dim i As Long
 Dim uRng As Range

 Application.ScreenUpdating = False
 Application.EnableEvents = False
 Application.Calculation = xlCalculationManual


 Set tbl = ThisWorkbook.Sheets("TheSheet").ListObjects("TheTable")

 i = tbl.ListRows.Count


 While i > 0
   If Application.WorksheetFunction.CountIf(Range("Included_Rows"), tbl.ListRows(i).Range.Cells(1).Value) = 0 Then

      'tbl.ListRows(i).Delete
      If uRng Is Nothing Then
       Set uRng = tbl.ListRows(i).Range
      Else
       Set uRng = Union(uRng, tbl.ListRows(i).Range)
      End If
   End If
   i = i - 1
 Wend

  If Not uRng Is Nothing Then uRng.Delete xlUp

 Application.ScreenUpdating = True
 Application.EnableEvents = True
 Application.Calculation = xlCalculationAutomatic

 End Sub