Excelで図形を削除する方が速い方法はありますか

Question

ピボットテーブルのセル（msoShapeOval）に図形を追加できました。

ピボット/スライサーの選択が変更された場合は、これらのシェイプをクリアして再作成する必要があります。

現在の方法は機能しますが、遅いです。

シェイプを一括消去する方法はありますか？
注：これらの図形がすべて存在する正確なセル範囲がわかります。

私もappiedました：

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

現在のコード：

Dim Shp as Shape 
    For Each Shp In rng.Parent.Shapes 
    If InStrB(Shp.Name, "$") > 0 Then Shp.Delete 
    Next 

Answer 1

を選択せず​​に、一度に図形を削除することが可能ですいくつかの微調整をしています。あなたがする必要がどのような

次されています：あなたはこのことからrectangularsを削除したいと想像してみましょうすべてのオブジェクト

て

• ループはすべて長方形の持つ配列を作ります名前
• アレイ内のオブジェクトを削除する

トリッキーな部分はオブジェクトをループすることです。なぜなら、配列を毎回インクリメントする必要があるからです。コレクションのような組み込みの機能ではありません。 incrementArrayはこのための関数です。

さらに、割り当てられていない配列に初めてインクリメントするときは、割り当てられているかどうかを確認する必要があります（以下の関数IsArrayAllocatedで実現）。

Option Explicit 

Sub TestMe() 

    Dim shp    As Shape 
    Dim arrOfShapes() As Variant 'the() are important! 

    With ActiveSheet 
     For Each shp In .Shapes 
      If InStrB(shp.Name, "Rec") > 0 Then 
       arrOfShapes = incrementArray(arrOfShapes, shp.Name) 
      End If 
     Next 
     If IsArrayAllocated(arrOfShapes) Then 
      Debug.Print .Shapes.Range(arrOfShapes(0)).Name 
      .Shapes.Range(arrOfShapes).Delete 
     End If 
    End With 
End Sub 

追加機能：

Public Function incrementArray(arrOfShapes As Variant, nameOfShape As String) As Variant 

    Dim cnt   As Long 
    Dim arrNew  As Variant 

    If IsArrayAllocated(arrOfShapes) Then 
     ReDim arrNew(UBound(arrOfShapes) + 1)    
     For cnt = LBound(arrOfShapes) To UBound(arrOfShapes) 
      arrNew(cnt) = CStr(arrOfShapes(cnt)) 
     Next cnt 
     arrNew(UBound(arrOfShapes) + 1) = CStr(nameOfShape) 
    Else 
     arrNew = Array(nameOfShape) 
    End If 

    incrementArray = arrNew 

End Function 

Function IsArrayAllocated(Arr As Variant) As Boolean 
    On Error Resume Next 
    IsArrayAllocated = IsArray(Arr) And _ 
         Not IsError(LBound(Arr, 1)) And _ 
         LBound(Arr, 1) <= UBound(Arr, 1) 

End Function 

arrOfShapesは、括弧を使用して宣言する必要があることを発見するためのthis guyにクレジット（私はそれを正しく渡すことができませんでした理由を研究し、約30分を費やしている）としますIsArrayAllocated()の場合はCPearsonです。

Answer 2

スライサーを除くすべての図形を削除するには：

Sub RemoveAllExceptSlicers() 

    Dim sh As Shape 

    For Each sh In ActiveSheet.Shapes 
     If Not sh.Type = MsoShapeType.msoSlicer Then 
      sh.Delete 
     End If 
    Next 

End Sub