循环遍历ListObject中的行来删除它们是非常缓慢的
我有一个〜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 我不确定是对工作表函数的依赖，还是只是循环放慢行速度。
有没有办法来过滤listobject并放弃其余的？
我正在考虑只是夹一个进度条，让用户可以看到发生的事情…
试试这个代码：
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
你的问题不是你在循环单元格。 事实上，你正试图从表中删除许多不连续的行; 每一个都需要对ListObject表进行内部重新sorting和重构。 任何你可以做的一次删除所有的行将有所帮助，如果你可以删除它们作为一个块，它会更好。 此外，您可能会重复计算整列公式的重复和冗余。
你应该更快地find下面的脚踏车。
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
我用Include_Rows命名范围中的AD对500行样本数据（AZ）运行此操作。 花了0.02秒。
尝试这个：
Dim Tbl As ListObject Set Tbl = Sheets(indx).ListObjects(Tabla) With Tbl If .ListRows.Count >= 1 Then .DataBodyRange.Delete End With
使用这样的代码删除列表对象中除第一行以外的所有内容。 通过删除整个行，它也适当调整表的大小。 tblData是一个ListObjectvariables，指向一个现有的表/列表对象。
tblData.DataBodyRange.Offset(1, 0).EntireRow.Delete
当然，你不能把数据放在表的左边或右边，因为它也会被删除。 但是这比循环要快得多。