将工作表的命名范围转换为工作簿，只覆盖一些命名范围的工作。

Question

我已经将一些代码（来自几个来源，参考文献在底部）整合在一起，以编程方式将工作表范围内的命名范围转换为工作簿命名范围。然而，我的代码只适用于一些命名的范围，而不是其他的，我不知道为什么。

我不得不这样做的原因是，我不得不从原始源中删除两个标签（其中一个标签包含_T，另一个包含_X），并从另一个源中复制这些标签的副本。这让我有了工作簿范围命名的#REF！#REF和工作表命名的范围，它们有我想要的范围，但我需要它们是工作簿范围。

请看下面的代码

如果我运行这段代码寻找"_T"，就能完美地工作。所有以 _T 开头的工作簿命名范围都是 #REF!#REF，现在有了正确的范围，它们对应的工作表命名范围被删除了。然而，如果我运行这个寻找"_X"，工作簿命名的范围就不会改变。我很困惑。我甚至尝试了另一种方法，即手动删除所有以 _X 开头的当前工作簿命名的范围，然后以编程方式尝试使用以下方法添加它们 ActiveWorkbook.Names.Add Name:=newNm,RefersTo:=nm.RefersTo 也没有任何作用（甚至没有添加新记录）。

先谢谢大家的帮助。

Sub WStoWBscope()

Dim nm As Name, Ans As Integer, newNm As String, fltr As String

fltr = "_X" 'search string


For Each nm In ActiveWorkbook.Names                'look at all named ranges within the current workbook
    If nm.Name Like "X!*" Then                     'looks for worksheet scoped named range that has the correct range
        If InStr(1, nm.Name, fltr) > 0 Then
            newNm = Replace(nm.Name, "X!", "")     'save name of existing workbook named range
            Range(nm.RefersTo).Name = newNm        'overwrite workbook named range with proper range
            nm.Delete                              'deletes worksheet named range
        End If
    End If
Next nm
End Sub

VBA将命名范围工作簿转换为工作表范围的方法用VBA将命名范围从工作表级别改为工作簿级别。

Answer 1

试试这个。

Sub ConvertWorksheetNamedRangesToWorkbookNamedRanges()
    Dim nName As Name
    'Loop Through each named Range
    For Each nName In ActiveWorkbook.Names
        'Is Name scoped at the Workbook level?
        If TypeOf nName.Parent Is Workbook Then

        End If
        'Is Name scoped at the Worksheet level?
        If TypeOf nName.Parent Is Worksheet Then
            ' If nm.Name Like "X!*" Then .....
            ' Do the filtering you need
            ' ....
                Dim sName As String
                sName = nName.Name 'Save the name of the name
                Dim rngName As Range
                Set rngName = Range(nName) ' Save the range of the name
                nName.delete    ' Delete the name
                'Create a new one on workbook scope
                ThisWorkbook.Names.Add Name:=sName, RefersToR1C1:="=" & rngName.Address(ReferenceStyle:=xlR1C1)
            ' End If
        End If
    Next nName
End Sub

Answer 2

只是为了文档的目的(不要加注，加注Viktor的回答。)这里是代码的最终版本。

Dim nm As Name, Ans As Integer, newNm As String, fltr As String, rngName As Range

'Filter named ranges that contain specific phrase
fltr = "_X"

'Search for all names in the workbook
For Each nm In ActiveWorkbook.Names
    'Search within those named ranges by those that have a specific worksheet scope
    If nm.Name Like "X!*" Then
        'Search for the named ranges of a type set by your filter (fltr)
        If InStr(1, nm.Name, fltr) > 0 Then
            'Take the full name [Scope]+[named range] and remove the scope
            newNm = Replace(nm.Name, "X!", "")
            'save the original range used by the worksheet-scoped named range 
            Set rngName = Range(nm)
            'delete the worksheet-scoped named range
            nm.Delete    
            'Create/Overwrite a workbook-scoped named range (this does overwrite any workbook-scoped named ranges that are the same name with #REF!#REF )
            ThisWorkbook.Names.Add Name:=newNm, RefersToR1C1:="=" & rngName.Address(ReferenceStyle:=xlR1C1)
        End If
    End If
Next nm
End Sub