遍历 ListObject 中的行以删除它们非常慢

Question

我有一个包含 ~500 行的 ListObject table，我在命名范围内也有 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

Answer 2

你的问题不在于循环遍历单元格。事实上，您正试图从 table 中删除许多不连续的行；每一个都需要对 ListObject table 进行内部重新排序和重组。您可以做的任何一次删除所有行的操作都会有所帮助，如果您可以将它们作为一个块删除，那就更好了。此外，您可能会重复和冗余地重新计算整列公式。

你应该更快地找到下面的 scootch。

Sub removeAccounts()

    Dim i As Long

    Debug.Print Timer
    Application.ScreenUpdating = False
    Application.Calculation = xlCalculationManual

    With ThisWorkbook.Sheets("TheSheet")
        With .ListObjects("TheTable")
            '.Range.Columns(2).Delete
            .Range.Columns(2).Insert
            With .DataBodyRange.Cells(1, 2).Resize(.DataBodyRange.Rows.Count, 1)
                .FormulaR1C1 = "=isnumber(match(RC[-1], Included_Rows, 0))"
                .Calculate
            End With
            .Range.Cells.Sort Key1:=.Range.Columns(2), Order1:=xlDescending, _
                              Orientation:=xlTopToBottom, Header:=xlYes
            With .DataBodyRange
                i = Application.Match(False, .Columns(2), 0)
                Application.DisplayAlerts = False
                .Cells(i, 1).Resize(.Rows.Count - i + 1, .Columns.Count).Delete
                Application.DisplayAlerts = True
            End With
            .Range.Columns(2).Delete
        End With
    End With

    Application.Calculation = xlCalculationAutomatic
    Application.ScreenUpdating = True
    Debug.Print Timer

End Sub

I 运行这针对 500 行样本数据 (A-Z)，A-D 在 Included_Rows 命名为运行ge。耗时0.02秒

Answer 3

试试这个：

Dim Tbl As ListObject
Set Tbl = Sheets(indx).ListObjects(Tabla)

With Tbl

If .ListRows.Count >= 1 Then .DataBodyRange.Delete

End With

Answer 4

使用这样的代码删除列表对象中除第一行以外的所有行。通过删除整行，它还适当地调整了 table 的大小。 tblData 是指向现有 table/listobject.

的 ListObject 变量

tblData.DataBodyRange.Offset(1, 0).EntireRow.Delete

当然，您不能在 table 的左侧或右侧放置数据，因为它也会被删除。但这比循环快得多。

遍历 ListObject 中的行以删除它们非常慢

Looping through rows in a ListObject to delete them is very slow

excel

performance

vba

delete-row

listobject