嗨，我看了你的VBA宏代码，问题主要出在判断命名区域是否属于当前工作表的逻辑完全搞反了，还有一些细节可以优化得更鲁棒。下面我给你拆解问题并给出修复后的完整方案：

原代码的核心问题 #

你写的InStr(1, ShName, nm.RefersTo)是在检查「命名区域的引用文本是否是工作表名的子字符串」——这完全反了！我们要的是检查「工作表名是否出现在命名区域的引用文本里」，而且原代码没考虑工作表名带空格时RefersTo会自动加单引号的情况，也没处理大小写不一致的问题。

修复后的完整宏代码 #

我优化了判断逻辑，还加了无匹配时的友好提示，让输出更清晰：

Sub ListNamesActiveSheet()
    Dim ShName As String
    Dim strNamesInSheet As String
    Dim nm As Name

    ShName = ActiveSheet.Name
    ' 初始化消息框文本，格式更友好
    strNamesInSheet = "活动工作表中的命名区域及引用：" & vbCr & vbCr

    For Each nm In ActiveWorkbook.Names
        ' 用两种匹配逻辑覆盖所有情况：带单引号的工作表名、不带单引号的工作表名
        If InStr(1, nm.RefersTo, "'" & ShName & "'", vbTextCompare) > 0 Or _
           InStr(1, nm.RefersTo, ShName & "!", vbTextCompare) > 0 Then
            ' 用→分隔名称和引用，提升可读性
            strNamesInSheet = strNamesInSheet & nm.Name & " → " & nm.RefersTo & vbCr
        End If
    Next nm

    ' 处理没有找到命名区域的情况
    If strNamesInSheet = "活动工作表中的命名区域及引用：" & vbCr & vbCr Then
        strNamesInSheet = "当前活动工作表没有任何命名区域"
    End If

    ' 带标题和信息图标的消息框，更友好
    MsgBox strNamesInSheet, vbInformation, "命名区域列表"
End Sub

关键修复点说明 #

• 修正InStr参数顺序：把InStr(1, ShName, nm.RefersTo)改成InStr(1, nm.RefersTo, 目标文本)，现在逻辑是检查工作表名是否存在于引用文本中，完全符合需求。
• 兼容带空格的工作表名：添加了"' & ShName & '"的匹配规则，因为当工作表名包含空格时，RefersTo会自动用单引号包裹（比如'销售数据'!$A$1:$C$5）。
• 忽略大小写差异：加入vbTextCompare参数，避免因为工作表名和引用文本的大小写不一致（比如工作表名是"Sheet1"，引用里是"SHEET1"）导致漏判。
• 无匹配友好提示：如果遍历后没有找到任何属于当前工作表的命名区域，会弹出明确提示，而不是空的消息框。
• 优化输出体验：用→分隔命名区域名称和引用文本，给消息框加了标题和信息图标，内容可读性大幅提升。

更可靠的进阶判断方式（推荐） #

如果想彻底避免解析文本的麻烦，还可以通过VBA对象模型直接判断命名区域的所属工作表，这种方式更稳定，不会受引用文本格式的影响：

Sub ListNamesActiveSheet_Advanced()
    Dim ShName As String
    Dim strNamesInSheet As String
    Dim nm As Name

    ShName = ActiveSheet.Name
    strNamesInSheet = "活动工作表中的命名区域及引用：" & vbCr & vbCr

    For Each nm In ActiveWorkbook.Names
        ' 直接通过Parent属性获取命名区域的所属工作表，逻辑更可靠
        If nm.Parent.Name = ShName Then
            strNamesInSheet = strNamesInSheet & nm.Name & " → " & nm.RefersTo & vbCr
        End If
    Next nm

    If strNamesInSheet = "活动工作表中的命名区域及引用：" & vbCr & vbCr Then
        strNamesInSheet = "当前活动工作表没有任何命名区域"
    End If

    MsgBox strNamesInSheet, vbInformation, "命名区域列表"
End Sub

这种方式利用nm.Parent.Name直接获取命名区域的父对象（也就是它所属的工作表），不管是工作表级的命名区域，还是指向当前工作表的工作簿级命名区域，都能准确判断，比解析RefersTo文本要靠谱得多。

现在运行修复后的宏，就能正确弹出消息框显示当前活动工作表的所有命名区域及其引用啦！