いらない名前の定義を削除します。
Sub いらない名前の定義を削除する()
ct = 0
Dim myDic As New Scripting.Dictionary
For Each nm In ThisWorkbook.Names
If InStr(nm.Name, "!") <> 0 Then
If myDic.Exists(Mid(nm.Name, InStr(nm.Name, "!") + 1)) = True Then
Else
myDic.Add Mid(nm.Name, InStr(nm.Name, "!") + 1), 1
End If
Else
If myDic.Exists(nm.Name) = True Then
Else
myDic.Add nm.Name, 1
End If
End If
Next
'Dictionaryオブジェクトの要素の参照
Dim str As String
Dim myObj As Range
Dim myRange As Range
For Each ws In ThisWorkbook.Worksheets
If ws.Visible = True Then
Set myRange = ws.UsedRange
For Each Var In myDic
If Var = "Print_Area" Then
Else
Set myObj = myRange.Find(Var, LookAt:=xlWhole)
If myObj Is Nothing Then
Set myObj = myRange.Find(Var, LookAt:=xlPart)
If myObj Is Nothing Then
For Each nm In Names
If InStr(nm.Name, Var) <> 0 Then
On Error Resume Next
nm.Delete
On Error GoTo 0
End If
Next
Else
End If
Else
End If
End If
Next Var
Exit For
End If
Next
End Sub
こんな感じです。
まだまだ短くなりました。
これからもっと短くならないかなあと思っています。