'一、刪除本工作簿內所有工作表的定義名稱
Sub 刪除定義名稱()
Dim wb As Workbook, MyF$, MyS
Application.ScreenUpdating = False
Application.DisplayAlerts = False
MyF = Dir(ThisWorkbook.Path & "\*.xls*")
Do
If MyF <> ThisWorkbook.Name Then
Set wb = Workbooks.Open(ThisWorkbook.Path & "\" & MyF)
For Each MyS In ActiveWorkbook.Names
MyS.Delete
Next MyS
wb.Close
End If
MyF = Dir
Loop While MyF <> ""
Application.ScreenUpdating = True
Application.DisplayAlerts = True
End Sub
Dim wb As Workbook, MyF$, MyS
Application.ScreenUpdating = False
Application.DisplayAlerts = False
MyF = Dir(ThisWorkbook.Path & "\*.xls*")
Do
If MyF <> ThisWorkbook.Name Then
Set wb = Workbooks.Open(ThisWorkbook.Path & "\" & MyF)
For Each MyS In ActiveWorkbook.Names
MyS.Delete
Next MyS
wb.Close 1
End If
MyF = Dir
Loop While MyF <> ""
Application.ScreenUpdating = True
Application.DisplayAlerts = True
End Sub
'二、刪除不某文件夾下非在本工作簿定義的定義名稱及錯誤引用遺留的定義名稱
Sub 刪除某工作簿中所有excel表的非法遺留的定義名稱()
Dim wb As Workbook, MyF$, MyS
Application.ScreenUpdating = False
Application.DisplayAlerts = False
MyF = Dir(ThisWorkbook.Path & "\下料單\*.xls*")
Do
' If MyF <> ThisWorkbook.Name Then
Set wb = Workbooks.Open(ThisWorkbook.Path & "\下料單\" & MyF)
Debug.Print wb.Name
For Each MyS In ActiveWorkbook.Names
Debug.Print MyS.Name & " " & MyS
If Left(MyS, 5) = "='E:\" Or Right(MyS, 6) = "!#REF!" Then
MyS.Delete
End If
Next MyS
wb.Close (True)
' End If
MyF = Dir
Loop While MyF <> ""
Application.ScreenUpdating = True
Application.DisplayAlerts = True
End Sub
’三、'在打開表的情況下執行
Sub 刪除不在本工作簿定義的定義名稱()
For Each d In ActiveWorkbook.Names
Debug.Print d.Name & " " & d
If Left(d, 5) = "='E:\" Or Right(d, 6) = "!#REF!" Then
d.Delete
End If
Next
End Sub
