trash-area.com ≫ blog ≫ EXCELEXCELで定義した名前を一括削除する方法(vba)

2010年04月26日 19

仕事でEXCELを使っていると、たまに「定義済みの名前」がひどいことになったりしますよね。
参照範囲がどこのネットワークを参照しているかもわからない名前とかが出てきます。

で、これらをEXCELのマクロ(vba)を使って一括で削除する方法。

Sub DeleteDefinedNames()
 
    Dim n As Name
    For Each n In ActiveWorkbook.Names
        n.Delete
    Next
 
End Sub

これで 1004 の実行時エラーにならなければまぁよいのですが
「その名前は正しくありません。」とかいうエラーになる場合、

Sub DeleteDefinedNames()
 
    Dim n As Name
    For Each n In ActiveWorkbook.Names
        On Error Resume Next  ' エラーを無視。
        n.Delete
    Next
 
End Sub

と、エラーを無視するコードを入れれば消せない名前以外は消せるようになりますが、
消せない名前は Ctrl+F3で出てくる[名前の定義]ダイアログから手動で消す必要があります。

で、これじゃあちょっとめんどくさいよねってことで、
名前を削除するマクロの実行時にエラーが出ないようにしておいてあげてから、
マクロを実行しようよっていう方法です。

(1) [ツール]-[オプション]-[全般] から 「R1C1 参照形式を使用する(C)」のチェック状態を反転して「OK」。
(2) [名前の重複]ダイアログが表示されたら変更後に適当な文字を入力して「OK」。
(3) 上記(2)を[名前の重複]ダイアログが出てこなくなるまで繰り返す。

この後、上記コードを実行することで名前の削除時にエラーは出なくなります。

と、ここまでを無理やりマクロで組んだ結果が以下です。(Excel2000, 2003にて確認)
なお、win32apiを使用している為、標準モジュールを追加して以下コードを貼り付けて下さい。

ちなみに何をやっているかというと、まず、上記R1C1参照形式を切り替えます。
で、名前の重複がある場合には[名前の重複]ダイアログが出ることを利用し、
このダイアログをタイマー監視し、ランダムな文字列で名前を付け直ししています。

Public Declare Function SetTimer Lib "user32.dll" (ByVal hwnd As Long, ByVal nIDEvent As Long, _
    ByVal uElapse As Long, ByVal lpTimerFunc As Long) As Long
Public Declare Function KillTimer Lib "user32.dll" (ByVal hwnd As Long, ByVal nIDEvent As Long) As Long
Public Declare Function FindWindow Lib "user32.dll" Alias "FindWindowA" (ByVal lpClassName As String, _
    ByVal lpWindowName As String) As Long
 
Sub DeleteDefinedNames()
 
    Dim beforeReferenceStyle As Variant
    beforeReferenceStyle = Application.ReferenceStyle
 
    Dim timerID As Long
    timerID = SetTimer(0, 0, 100, AddressOf TimerProc)
 
    If beforeReferenceStyle = xlR1C1 Then
        Application.ReferenceStyle = xlA1
    Else
        Application.ReferenceStyle = xlR1C1
    End If
 
    Dim n As Name
    For Each n In ActiveWorkbook.Names
        If Not n.Name Like "*!Print_Area" And _
            Not n.Name Like "*!Print_Titles" Then
            n.Delete
        End If
    Next
 
    Application.ReferenceStyle = beforeReferenceStyle
 
    KillTimer 0, timerID
 
End Sub
 
Private Sub TimerProc()
 
    Dim hwnd As Long
    hwnd = FindWindow("bosa_sdm_XL9", "名前の重複")
 
    If hwnd > 0 Then
        SendKeys getRandomString(3, 20), 10
        SendKeys "{ENTER}"
    End If
 
End Sub
 
Private Function getRandomString(min As Long, max As Long) As String
 
    Dim s As String
    Dim i As Long
 
    max = Int(max * Rnd)
 
    For i = 0 To min + max
        Randomize
        s = s & Chr(65 + Int(26 * Rnd))
    Next
 
    getRandomString = s
 
End Function
ソーシャルブックマーク
はてな Livedoor del.icio.us
関連してそうな記事
同じカテゴリーの別の記事
タグ
, ,
トラックバックURL
  1. TIPS : Excelの「名前」(定義済みの名前)をきれいに削除する方法…

    どこからか持ってきたExcelを使って作業をしていると、シートコピーとかするとき…

  2. […] 時々、入力するよう渡されたエクセルのファイルで、シートのコピーをしようとすると、領域名のエラーが大量に出てしまう事がありまして。また当たってしまったのでその処理の覚書き。(☆環境はWindows8.1 Excel2013 ですが、多分バージョン関係なく出ると思います。)こんな感じのヤツ数個程度なら[はい(Y)]を押せばいいのですが、何百個(もしかしたら何千?※)になるとウンザリしてきますし、効率が悪くて仕事にならない。(※マクロを使ってカウントさせてみたら2万以上ありました・・・><)なんでこうなるのか原因がいまいちよく分からないのですが、使用できない文字が領域名に使われているとか?書類のテンプレートとして沢山の人・沢山のプロジェクトで使いまわされて上書きを繰り返されたファイルがなるとか?「Y」キーを押しっぱなしにして気長に待てはいずれ終わりますが※終わった後セルにYYYYYYYと入力されてしまいますので何もないセルを選択した状態でやりましょう(笑)それでも大量にあると結構待たされます。シートを複数コピーしたい時など毎回出るのでは仕事にならない(-_-;)この領域名を削除するには■方法1[数式]→[名前の管理]で出るダイアログから削除できます削除できるはず・・・出来た人はおめでとうございます。しかぁし!全部選択して削除ボタンを押すと、ダイアログ内も空白になり成功したように見えますが、ダイアログを閉じてもう一度[名前の管理]を開いてみると、できてない・・・こんな簡単にできるなら、多分エラー出てないですよね・・・(+_+)■方法2検索してみると同様の問題で悩んでいる人は多いようで、領域名を消してくれるマクロを作って下さっている方が居ます、有りがたい事です。Server World高密度商業地域他にも、探すと結構たくさんありますね。ところが・・・以前のバージョンのエクセルはこれらのシンプルなマクロで削除できていたのですが、2013だからでしょうか?今回はこれらのマクロでもうまく行きませんでした。■方法3こちら(trash-area.com)で解説されてた方法オプションの中にある「R1C1 参照形式を使用する(C)」のチェック状態を入れてやると、[名前の重複]と言うダイアログが出てきて、名前の変更を求めらます。いちいち手動で修正してられませんので、ランダムな名前を自動的につけさせてしまうマクロを書いてくださっています。やってみました⇒ できた!!ように見えたのですが・・・ファイルを保存しようとすると、エラーで落ちてしまう・・・(><)ザンネ~ン!!■方法4もうしょうがない、力技で(笑)シートの複写を使わずに、セルを全選択してコピー、新しいシートにペーストするとエラーが出ないようです。新しいブックに張り付けてやれば、名前はついてこないで中身だけコピーできるようです。シートの数が少なければこれで新しいファイルに保存しなおしてあげたほうが早いですね。で、シートの数が多かったので面倒だったので、私もマクロを書いて処理しました。すべてのシートを新しいブックの新しいシートに複写するマクロです。Sub シート全て複写()' エラー時の処理ルーチンOn Error GoTo Err' クリップボードを空にApplication.CutCopyMode = False' 現在のブック名取得Dim SourceBook As StringSourceBook = ActiveWorkbook.Name' 新規ブック作成Workbooks.Add' 新規ブック名取得Dim TargetBook As StringTargetBook = ActiveWorkbook.NameWindows(SourceBook).Activate' ページ設定変数宣言Dim strSheetName As StringDim strPaperSize As StringDim strOrientation As StringDim intZoom As IntegerDim strLeftMargin As StringDim strRightMargin As StringDim strTopMargin As StringDim strBottomMargin As StringDim strHeaderMargin As StringDim strFooterMargin As StringDim strView As StringDim varPrintQuality As Variant' 処理For I = 1 To Worksheets.Count ' 繰り返し処理Sheets(I).Select ' シート選択' 現在シートの設定取得strSheetName = ActiveSheet.NamestrPaperSize = ActiveSheet.PageSetup.PaperSizestrOrientation = ActiveSheet.PageSetup.OrientationintZoom = ActiveSheet.PageSetup.ZoomstrLeftMargin = ActiveSheet.PageSetup.LeftMarginstrRightMargin = ActiveSheet.PageSetup.RightMarginstrTopMargin = ActiveSheet.PageSetup.TopMarginstrBottomMargin = ActiveSheet.PageSetup.BottomMarginstrHeaderMargin = ActiveSheet.PageSetup.HeaderMarginstrFooterMargin = ActiveSheet.PageSetup.FooterMarginvarPrintQuality = ActiveSheet.PageSetup.PrintQualitystrView = ActiveWindow.View' セル全選択・コピーCells.SelectSelection.Copy' Window切替Windows(TargetBook).Activate' 新規シート追加Sheets.Add After:=ActiveSheet' 貼り付けActiveSheet.Paste' ページ設定ActiveSheet.Name = strSheetNameActiveSheet.PageSetup.PaperSize = strPaperSizeActiveSheet.PageSetup.Orientation = strOrientationActiveSheet.PageSetup.Zoom = intZoomActiveSheet.PageSetup.LeftMargin = strLeftMarginActiveSheet.PageSetup.RightMargin = strRightMarginActiveSheet.PageSetup.TopMargin = strTopMarginActiveSheet.PageSetup.BottomMargin = strBottomMarginActiveSheet.PageSetup.HeaderMargin = strHeaderMarginActiveSheet.PageSetup.FooterMargin = strFooterMarginActiveSheet.PageSetup.PrintQuality = varPrintQualityActiveWindow.View = strView' A1セル選択Range("A1").Select' 元ファイル選択・A1セル選択Windows(SourceBook).ActivateRange("A1").SelectNextErr:Resume Next ' エラーの場合も次の処理続行End Subこれでなんとか、無事クリーンなファイルにすることができました。\(^o^)/ table.btmcm{border:none;width:100%;margin:0;padding:0;} table.btmcm td{border:none;vertical-align:top;} […]

コメント
19 Comments
  1. pon

    2011.02.14 @ 2:59 PM

    考えましたね。素晴らしい!

  2. mizutama

    2011.05.20 @ 2:32 PM

    ずっと、解決したかったことが解決できました!
    ありがとうございます~!

  3. wyoco

    2011.11.10 @ 10:43 AM

    メチャメチャ素晴らしいです!
    お借りしました。どうもありがとうございます。

  4. wakaritai

    2012.01.19 @ 11:55 AM

    マクロを実行した際に
    25行目のn.deleteのところで
    止まってしまうんですが、(黄色くなる)
    何か原因は考えられますか?

  5. whitefan

    2012.04.10 @ 2:17 PM

    このマクロはすばらしい。
    他にも名前の定義削除マクロがありましたが、全て削除できるものは
    ありませんでした。
    ありがとうございます。

  6. 2012.05.22 @ 11:27 AM

    すばらしいコードです。
    ずっと知りたかったことがわかりました。
    利用させていただきました。

  7. kewpie3kewpie3

    2012.05.24 @ 5:08 PM

    これはいいです。大変便利です。ありがとうございました。

  8. hide_nyanta

    2012.07.12 @ 2:36 PM

    大変素晴らしいコードを実現して頂いてありがとうございます。
    利用させていただきました。

    数年来の悩みが解消で大変スッキリしました。

    ・・・売れますよ。コレ(^o^)

  9. coin

    2012.10.1 @ 4:47 PM

    先ほど試したファイルには自動削除不可能な名前定義が7000件
    あったのですが、見事削除できました。
    苦労していただけに感動ものです。有難うございました。

    本当はMicrosoftが解決すべき問題だとは思いますが…

  10. cheese999

    2012.11.2 @ 9:32 AM

    すっきりしましたぁ~。

  11. cheese999

    2012.11.11 @ 5:12 AM

    ありがたく使用させていただいております。
    (^_0)ノ

  12. erika

    2013.02.18 @ 4:24 PM

    すばらしい~!ありがとうございますTT。

  13. erika

    2013.02.18 @ 4:25 PM

    すばらしい!ありがとうございます。TT

  14. hotta

    2015.03.6 @ 1:36 PM

    助かりました。他サイトで見つけたものはエラーを吐いていたのですが、解決できました。

  15. hotta

    2015.03.6 @ 1:37 PM

    ありがとうございました。他で見つけたのはエラー出たので助かりました。

  16. 大和田まあちゃん

    2015.12.19 @ 10:48 AM

    すごいですねえ
    私にもこんな頭脳がほしい
    やっと見つけました
    ありがとうございます

  17. excel 爺さん

    2017.10.3 @ 1:49 PM

    仕事で使っているファイルでいつも変なメッセージ出て困っていました。どこのサイトを見ても解決方法は載っていませんでした。これで解消です。何年間も胸に詰まっていたものが、すーと取れた感じです。ありがとうございます。

Comment RSS

コメントをどうぞ

*反映されるまでに時間がかかることがあります。
*メールアドレスはアバターの使用に使います。