転用、商業利用等フリーです。ダウンロードしてご自由にお使いください。
セルをコピーしまくった結果、図形が増殖してしまってやたらエクセルが重くなってしまった。なんてあるあるだと思います。そんなときにボタン１つで簡単に消せるマクロを作りました。ポチッとするだけでダブっている図形が一気に消せちゃいます。重い原因がわからない時に、とりあえずポチってみるのもいいかもしれません。それでは以下に紹介したいと思います。
ダウンロードはここから
使用方法
ダウンロードしたエクセルと、図形を削除したいエクセルを一緒に開いて、ダウンロードしたエクセルのボタンをクリックするだけです。簡単です。
重複があり削除ができると「〇〇個の重複した図形を削除しました。」とメッセージが出ます。反対に一個も削除していない場合は「重複はありませんでした。」と出ます。
メッセージを見て削除ができたか、そうでないかを確認して終了となります。
またVBAに慣れている方であれば、下にコードを載せておくので、コピペして実行していただいてもOKです。
マクロについて
マクロの解説
今回は「Shapeオブジェクト」と「For Eachステートメント」を利用したマクロです。
「Shapeオブジェクト」同士、つまり図形同士を比較して、サイズとシート内の位置が一緒であれば重複していると判断して削除する、といった流れになっています。
比較しているのが「Shapesオブジェクト」のため、実際には図形だけでなくグラフや画像などもサイズと位置が同じであれば削除しています。
それを「For Eachステートメント」で全シート、全ブックで実行しています。
VBAコード
Sub 重複した図形の削除()
Dim 削除カウント As Long '削除数を表示するためのカウンターを設定
'このエクセルのボタンで削除ができるように、全てのブックとシートで処理を実行
For Each 全ブック In Workbooks
For Each 各シート In 全ブック.Worksheets
'シート内の図形同士を比較するために、二重の「For Eachステートメント」を記述
For Each 図形A In 各シート.Shapes
For Each 図形B In 各シート.Shapes
'図形B削除による図形Aエラー回避のため、同一の図形を比較した時に処理を抜ける
If 図形A.ID = 図形B.ID Then Exit For
'サイズとシート内の位置が同値の図形を重複と判断して削除
If 図形A.Height = 図形B.Height And 図形A.Width = 図形B.Width And _
図形A.Top = 図形B.Top And 図形A.Left = 図形B.Left Then
図形B.Delete
削除カウント = 削除カウント + 1 '削除数を表示するためのカウンターを加算
End If
Next
Next
Next
Next
'結果確認のためのメッセージを表示
If 削除カウント = 0 Then
MsgBox "重複はありませんでした。"
Else
MsgBox 削除カウント & "個の重複した図形を削除しました。"
End If
End Subまとめ
以上、重複している図形を一気に消すマクロでした。VBA的には非常にシンプルで簡単な割に、なかなか効果があるのではないかと思います。重複して増えすぎた図形を消したいとき、原因不明の重さをなんとかしたいとき、ポチってみてください。
ご拝読ありがとうございました。
配布しているエクセルの不具合、要望、改善点などありましたら、コメントもしくは問い合わせフォームからご指摘いただければ幸いです。
またこのサイトではリクエストも受け付けています。「あんなエクセルが欲しい」「こんな風に魔改造して」といったご要望があれば、リクエストフォームからお気軽にご連絡ください。
コメント