重なった図形を最前面のもの以外削除する

セルのコピーを伴う作業を何度も行ったExcelファイルを見てみると、
同じ図形が同じ場所に大量に溜まっていることがあります。

これを一括で整理整頓する機会があったため使用したコードを共有しておきます。

ソースコード

Sub 重なっている同じ図形を最前面のもの以外削除する(対象シート As Worksheet)

    ' 最前面の図形を記録するDictionary
    Dim Dic最前面図形 As New Dictionary
    Dim Dic最前面図形Zorder As New Dictionary

    ' すべての図形をループ
    Dim シェイプ As Shape
    For Each シェイプ In 対象シート.Shapes

        ' 図形のType・位置・大きさをキーとして同一図形が重なっているかを判定
        Dim key図形Type位置大きさ As String
        With シェイプ
            key図形Type位置大きさ = .Type & "_" & .Top & "_" & .Left & "_" & .Height & "_" & .Width
        End With
        
        ' 新規の図形を登録
        If Dic最前面図形.Exists(key図形Type位置大きさ) = False Then
            Dic最前面図形.Add key図形Type位置大きさ, シェイプ
            Dic最前面図形Zorder.Add key図形Type位置大きさ, シェイプ.ZOrderPosition
        
        ' Type位置大きさが一致してかつ前面の図形であれば書き換え
        ElseIf シェイプ.ZOrderPosition > Dic最前面図形Zorder(key図形Type位置大きさ) Then
            Set Dic最前面図形(key図形Type位置大きさ) = シェイプ
            Dic最前面図形Zorder(key図形Type位置大きさ) = シェイプ.ZOrderPosition
        End If

    Next
    
    ' 図形の存在判定用にItemの図形をKeyに移す
    Dim Dic最前面図形リスト As New Dictionary
    Dim key
    For Each key In Dic最前面図形.Keys
        Dic最前面図形リスト.Add Dic最前面図形(key), Empty
    Next

    ' 最前面リストに乗っていない図形をすべて削除
    For Each シェイプ In 対象シート.Shapes
        If Dic最前面図形リスト.Exists(シェイプ) = False Then
            シェイプ.Delete
        End If
    Next

End Sub

解説

上記のマクロを実行すると、図形の種類、位置、大きさがすべて同じ図形の内、
最前面のもの以外の図形がすべて削除されます。

この手の「複数のパラメータが同じもの」を判定・管理するには、
全パラメータを文字列結合したものをKeyにしたDictionaryを使うのがおすすめです。

今回のコードも結構複雑な処理をしていると思いますが、
上記コードのようにかなり簡潔に書くことができます。

マクロのロジックとしては、

• keyに「Type_縦位置_横位置_高さ_幅」を用いたDictionaryを用意
• これで重なった図形につきItemをひとつだけに絞ることができる
• Zorder(前面/背面位置)をItemにいれたDictionaryで最前面を判定
• もう一つのDictionary(Keyを連動)に最前面図形そのものを入れておく
• 出来上がった最前面図形をItemからKeyに移す(Existsを使いたいので)
• 再度全図形をループし、最前面図形群にない図形を削除

という手順を踏んでいます。

DictionaryのKey・Itemにはオブジェクトをそのまま使うこともでき、
Shapeオブジェクトの一致判定もKeyのExistsで行うことができます。

この仕様を活用したコードですね。

この仕様を活用しないとShapeの一致判定は結構難しく、
というのもShapeは同一名称を許すためNameが一意ではありません。

こうなるとString型で存在判定や一致判定ができませんので、
オブジェクトの一致判定をかける必要が出てきます。

For Each + Is演算子でこれをやってもいいのですが、
今回のようにDictionaryのKey/ItemをShapeにしてしまうのが楽ですね。

オブジェクトをKey/Itemにしたサンプルとしてもちょうどいいコードなので、
Dictionaryの勉強にも活用してみてください。