3

〜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

ワークシート関数に依存しているのか、行をループしているだけなのか、速度が低下しているのかはわかりません。

リストオブジェクトをフィルタリングして残りを破棄する方法はありますか?

ユーザーが何かが起こっているのを見ることができるように、進行状況バーをチャックすることを考えていました...

4

4 に答える 4

4

このコードを試してください:

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
于 2015-12-21T02:19:25.677 に答える
0

これを試して：

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

With Tbl

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

End With
于 2016-05-12T15:01:57.770 に答える
0

次のようなコードを使用して、リスト オブジェクトの最初の行以外をすべて削除します。行全体を削除することで、テーブルのサイズも適切に変更されます。tblData既存のテーブル/リスト オブジェクトを指す ListObject 変数です。

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

もちろん、テーブルも削除されるため、テーブルの左右にデータを配置することはできません。しかし、これはループよりもはるかに高速です。

于 2016-10-29T17:55:27.617 に答える