通过ListObject中的行循环删除它们是非常慢的 [英] Looping through rows in a ListObject to delete them is very slow

问题描述

我有一个约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 
 
 
虽然我> 0 
如果Application.WorksheetFunction.CountIf（Range（Included_Rows），tbl.ListRows（i）.Range.Cells（1）.Value）= 0然后
 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 
 
 
设置tbl = ThisWorkbook.Sheets TheSheet）。ListObjects（TheTable）
 
i = tbl.ListRows.Count 
 
 
虽然我> 0 
如果Application.WorksheetFunction.CountIf（Range（Included_Rows），tbl.ListRows（i）.Range.Cells（1）.Value）= 0然后
 
'tbl.ListRows （i）。删除
如果uRng不是，然后
设置uRng = tbl.ListRows（i）.Range 
 Else 
设置uRng = Union（uRng，tbl.ListRows（i ）.Range）
 End If 
 End If 
i = i  -  1 
 Wend 
 
如果不是uRng不是，那么uRng.Delete xlUp 
 
 Application.ScreenUpdating = True 
 Application.EnableEvents = True 
 Application.Calculation = xlCalculationAutomatic 
 
 End Sub 
  / pre> 
I have a ListObject table with ~500 rows, I've also got 4 values in a named range.  

There are maybe 30 unique values that occur repeatedly (At random) for the 500 rows, I want to delete all rows whose values are not in the named range.  

I have the following which works, but it is running slower than expected (approximately 2 min):  
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
I'm not sure whether it's the reliance on the worksheet function or just looping through the rows that is slowing it down.  

Is there a way to filter the listobject and discard the rest?

I was thinking of just chucking a progress bar on it so that the users can see something happening...
解决方案
Try this Code:
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中的行循环删除它们是非常慢的的文章就介绍到这了，希望我们推荐的答案对大家有所帮助，也希望大家多多支持IT屋！