删除未引用当前活动工作簿的命名范围VBA代码问题求助

原代码存在语法结构错误和逻辑判断问题，导致无法正常执行，以下是问题分析和修正方案：

原代码的核心问题 #

• 循环结构混乱：For Each i循环内的If语句没有正确闭合，Next i、Else、End If的位置完全不符合VBA语法规则，直接导致编译报错。
• 判断逻辑错误：n.RefersTo返回的是字符串格式的引用表达式（例如=Sheet1!$A$1），无法直接与工作表对象进行比较，这种判断永远不会成立。
• 冗余遍历逻辑：无需遍历所有工作表来验证命名范围归属，直接检查命名范围是否指向外部工作簿即可。

修正后的代码 #

Sub DeleteExternalNames()
    Dim n As Name
    Dim i As Integer
    
    ' 反向遍历命名范围集合，避免删除元素导致的遍历遗漏
    For i = ActiveWorkbook.Names.Count To 1 Step -1
        Set n = ActiveWorkbook.Names(i)
        On Error Resume Next ' 处理无法获取引用范围的情况（如常量引用、外部已关闭工作簿）
        ' 检查引用范围是否属于当前工作簿
        If Not n.RefersToRange.Parent.Parent Is ActiveWorkbook Then
            n.Delete
        End If
        On Error GoTo 0 ' 恢复错误捕获
    Next i
End Sub

代码说明 #

• 反向遍历：由于删除命名范围会改变Names集合的元素数量，反向遍历可以避免遗漏未处理的元素。
• 错误处理：添加On Error Resume Next处理特殊情况（比如命名范围引用的是常量、公式，或者外部工作簿已关闭），防止代码因报错中断。
• 归属判断：通过n.RefersToRange.Parent.Parent获取命名范围所属的工作簿，与当前活动工作簿对比，判断是否为外部引用。

内容的提问来源于stack exchange，提问作者Vahid Bahrami