VBA Excel选择并删除具有相同ID的所有形状并删除

我想从我的工作表中删除所有形状。他们有相同的身份证

我发现了两个密码：

第一个：

Public Sub ActiveShapes()
    Dim ShpObject As Variant

    If TypeName(Application.Selection) = "Firestop" Then
        Set ShpObject = Application.Selection
        ShpObject.Delete
    Else
        Exit Sub
    End If
End Sub

它不起作用。没有错误，但也没有任何反应

第二条：

可以工作，但只能逐个删除元素。在我的事件中，所有元素都有Firestop ID。我想让它们一次全部删除。我该怎么做呢？

问题是，如果TypeNameApplication.Selection=Firestop，那么就永远不会是真的。查看，它不会返回Application.Selection的名称，而是返回Application.Selection的类型。在这里，它可能返回Object，因为形状是一个对象

实际上，名称是唯一的。不能添加具有相同名称的两个形状。这就是ActiveSheet.ShapesFirestop.Delete仅删除一个形状的原因

似乎有一个bug，当你复制一个命名的形状时，存在两个同名的形状，这是不可能的。您可以通过在循环中删除该形状来解决此问题，直到出现错误为止，不会留下具有该名称的形状

On Error Resume Next
Do
    ActiveSheet.Shapes("Firestop").Delete
    If Err.Number <> 0 Then Exit Do
Loop
On Error GoTo 0 'don't forget this statement after the loop

问题是，如果TypeNameApplication.Selection=Firestop，则永远不会为真。查看，它不会返回Application.Selection的名称，而是返回Application.Selection的类型。在这里，它可能返回Object，因为形状是一个对象

实际上，名称是唯一的。不能添加具有相同名称的两个形状。这就是ActiveSheet.ShapesFirestop.Delete仅删除一个形状的原因

似乎有一个bug，当你复制一个命名的形状时，存在两个同名的形状，这是不可能的。您可以通过在循环中删除该形状来解决此问题，直到出现错误为止，不会留下具有该名称的形状

On Error Resume Next
Do
    ActiveSheet.Shapes("Firestop").Delete
    If Err.Number <> 0 Then Exit Do
Loop
On Error GoTo 0 'don't forget this statement after the loop

---

建议不要经常使用错误恢复。我们建议仅在必要时使用它

Sub test()
    Dim shp As Shape
    Dim Ws As Worksheet

    Set Ws = ActiveSheet
    For Each shp In Ws.Shapes
        If shp.Name = "Firestop" Then
            shp.Delete
        End If
    Next shp
End Sub

---

建议不要经常使用错误恢复。我们建议仅在必要时使用它

Sub test()
    Dim shp As Shape
    Dim Ws As Worksheet

    Set Ws = ActiveSheet
    For Each shp In Ws.Shapes
        If shp.Name = "Firestop" Then
            shp.Delete
        End If
    Next shp
End Sub

---

您好，我以前使用过：ActiveSheet.RangeD24.PasteSpecial Selection.Name=Firestop是什么为所有这些文件创建了Firestop ID的。这就是我不再有唯一ID的原因。@MariuszKrukar是的，这个错误仍然没有修复。看看我编辑过的答案。您可以使用该解决方法。您好，我以前使用过：ActiveSheet.RangeD24.PasteSpecial Selection.Name=Firestop是什么为所有这些设置了Firestop ID的。这就是我不再有唯一ID的原因。@MariuszKrukar是的，这个错误仍然没有修复。看看我编辑过的答案。您可以使用该解决方法。虽然您通常是正确的，但如果有比Firestop更多的具有其他名称的形状，则“错误恢复下一步”方法可能会更快。取决于Firestop与其他名称的比率。无论如何，你会得到我的投票。看一看，我改进了我的答案，把错误踢到了循环之外，所以我们只使用了一次：现在这肯定比在所有形状中循环要快。只是为了好玩@Pᴇʜ：两种方法都很快。在我的测试中，Dy.Lees方法大约快1微秒P在不同的试验中可能会有所不同。我在一个有717个形状的工作表上测试了这两个代码。其中229个形状具有相同的名称。用来记录时间。如果你们两个得到不同的结果，请告诉我。。。顺便说一句，两个答案都投了赞成票。。。干得好@SiddharthRout，干得好。@SiddharthRout只是出于好奇，我做了一些测试：1000个不同的形状+5个命名为AAA的形状。我的代码是3,68E-02，李的是4,85E-02。最佳案例1000个形状，无AAA，因此无需删除我5,91E-03注释E-03和dy.lee 4,51E-02。最坏情况1000个形状AAA，全部删除：me 0,65和dy.lee 0,59.•这正是我所猜测的。如果有很多独特的形状，只有几个重复的名字，我的速度会比我想象的要快一点。如果复制品多而单件少，Dy.Lee的速度会更快。事实上，这两种方法都是快速闪现的。虽然你大体上是正确的，但是如果有比Firestop更多的其他名称的形状，那么错误恢复下一种方法可能会更快。取决于Firestop与其他名称的比率。无论如何，你会得到我的投票。看一看，我改进了我的答案，把错误踢到了循环之外，所以我们只使用了一次：现在这肯定比在所有形状中循环要快。只是为了好玩@Pᴇʜ：两种方法都很快。在我的测试中，Dy.Lees方法大约快1微秒P在不同的试验中可能会有所不同。我在一个有717个形状的工作表上测试了这两个代码。其中229个形状具有相同的名称。用来记录时间。如果你们两个得到不同的结果，请告诉我。。。顺便说一句，两个答案都投了赞成票。。。干得好@SiddharthRout，干得好。@SiddharthRout只是出于好奇，我做了一些测试：1000个不同的形状+5个命名为AAA的形状。我的代码是3,68E-02，李的是4,85E-02。最佳案例1000个形状，无AAA，因此无需删除我5,91E-03注释E-03 an 李迪4,51E-02。最坏情况1000个形状AAA，全部删除：me 0,65和dy.lee 0,59.•这正是我所猜测的。如果有很多独特的形状，只有几个重复的名字，我的速度会比我想象的要快一点。如果复制品多而单件少，Dy.Lee的速度会更快。事实上，两者都是快速闪现。