不要な名前の定義をVBAで一括削除する

名前の定義が邪魔

セルには「A1」などの座標がありますが、セル範囲に名前を付けて座標の別名として扱うことが出来るようになります。これが「名前の定義」です。

うまく使えば便利な機能ですが、複数の人が扱うブックに名前の定義を設定するのは避けた方がよいでしょう。

複数の人が扱うブックであれば通常はファイルサーバに置いてあると思いますが、ファイルサーバのどこかの参照先を指して名前の定義をしていると、その参照先が月日が経つことで存在しなくなることが多々あります。

名前の定義の値が「#REF!」になっていて参照先が存在しない場合や、ファイルパスが見たことも内容な場所を示していたりとか。年月を経てこの状況になっているため、これらの解決手段はほとんどの場合まず無いと言っていいでしょう。

そうなるともう悲惨です。

シートをコピーする度に「既にある名前が含まれています」エラーダイアログが多発し、エラーの数だけOKボタンを連打する羽目になります。イライラMAXです。

これが嫌いなので私は名前の定義は使いません。自分だけしか使わないブックであってもです。

以下ではこのような不要な名前の定義を一括削除するマクロを紹介します。

アクティブブックの名前の定義を一括削除するコード

以下の関数を実行するとアクティブブックに定義されている名前の定義を一括削除します。

一括削除しますが、「Print_Area」と「Print_Titles」の２つは削除しないようにしています。

Excelには自動で名前の定義を設定するものが２つあります。それが印刷範囲を示す「Print_Area」と、印刷タイトルを示す「Print_Titles」です。

この２つは定義自体は自動設定されるため、参照先が不正になることはまずありません。また、印刷範囲は個別に調整しているがよくあるため、削除してしまうと印刷範囲の設定が消えることになります。

そのため、この２つは削除はしないようにしています。

Sub DeleteNameDefine()
    On Error Resume Next
    
    Dim n       As Name         '// 名前の定義（Nameオブジェクト）
    Dim ar()    As String       '// 削除した名前の定義の配列
    Dim s       As String       '// MsgBox出力文字列
    Dim sName   As Variant      '// Nameプロパティ値
    Dim er()    As String       '// エラーで削除できなかった名前の定義の配列
    
    '// 配列初期化
    ReDim ar(0)
    ReDim er(0)
    
    '// 全ての名前の定義をループ
    For Each n In ActiveWorkbook.Names
        '// 印刷範囲と印刷タイトルの場合は処理対象外
        If InStr(1, n.Name, "Print_Area") > 0 Or InStr(1, n.Name, "Print_Titles") > 0 Then
            GoTo CONTINUE
        End If
        
        '// 名前の定義の名称を保持（Nameプロパティ取得）
        sName = n.Name
        
        '// 名前の定義を削除
        Call n.Delete
        
        '// エラー分
        If Err.Number <> 0 Then
            ReDim Preserve er(UBound(er) + 1)
            er(UBound(er) - 1) = sName
        '// 正常に削除した分
        Else
            ReDim Preserve ar(UBound(ar) + 1)
            ar(UBound(ar) - 1) = sName
        End If
        
        Err.Clear
CONTINUE:
    Next
    
    If ar(0) <> "" Then
        ReDim Preserve ar(UBound(ar) - 1)
    End If
    If er(0) <> "" Then
        ReDim Preserve er(UBound(er) - 1)
    End If
    
    '// エラー分を列挙
    For Each sName In er
        s = s & sName & vbCr
        Debug.Print sName
    Next
    
    Call MsgBox(s, vbOKOnly, "削除した名前の定義")
End Sub

Sub DeleteNameDefine()

On Error Resume Next

Dim n As Name '// 名前の定義（Nameオブジェクト）

Dim ar() As String '// 削除した名前の定義の配列

Dim s As String '// MsgBox出力文字列

Dim sName As Variant '// Nameプロパティ値

Dim er() As String '// エラーで削除できなかった名前の定義の配列

'// 配列初期化

ReDim ar(0)

ReDim er(0)

'// 全ての名前の定義をループ

For Each n In ActiveWorkbook.Names

'// 印刷範囲と印刷タイトルの場合は処理対象外

If InStr(1, n.Name, "Print_Area") > 0 Or InStr(1, n.Name, "Print_Titles") > 0 Then

GoTo CONTINUE

End If

'// 名前の定義の名称を保持（Nameプロパティ取得）

sName = n.Name

'// 名前の定義を削除

Call n.Delete

'// エラー分

If Err.Number <> 0 Then

ReDim Preserve er(UBound(er) + 1)

er(UBound(er) - 1) = sName

'// 正常に削除した分

Else

ReDim Preserve ar(UBound(ar) + 1)

ar(UBound(ar) - 1) = sName

End If

Err.Clear

CONTINUE:

If ar(0) <> "" Then

ReDim Preserve ar(UBound(ar) - 1)

End If

If er(0) <> "" Then

ReDim Preserve er(UBound(er) - 1)

End If

'// エラー分を列挙

For Each sName In er

s = s & sName & vbCr

Debug.Print sName

Call MsgBox(s, vbOKOnly, "削除した名前の定義")

End Sub

コード説明

大体コメントに書いていますが、少し補足します。

コード内ではエラー処理をしています。その理由は、名前の定義の削除を行うDeleteメソッドでは消せない定義があった場合の措置です。

名前の定義の「名前」に制御文字が含まれているとDeleteメソッドがエラーになります。この場合はVBAでは消せないため、手で「名前の管理」ダイアログ（リボン→数式→定義された名前→名前の管理）から対象行を選択して削除する必要があります。

そのため、そのようなエラーが発生した場合はイミディエイトウィンドウとメッセージボックスでその名前を表示して、手で消すことを促すようにしています。

名前の定義が邪魔

アクティブブックの名前の定義を一括削除するコード

コード説明

関連記事